aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/beam/big.c8
-rw-r--r--erts/emulator/beam/big.h8
-rw-r--r--erts/emulator/beam/copy.c113
-rw-r--r--erts/emulator/beam/erl_alloc.types3
-rw-r--r--erts/emulator/beam/erl_bif_lists.c4
-rw-r--r--erts/emulator/beam/erl_binary.h19
-rw-r--r--erts/emulator/beam/erl_db.c42
-rw-r--r--erts/emulator/beam/erl_db_hash.c50
-rw-r--r--erts/emulator/beam/erl_db_tree.c325
-rw-r--r--erts/emulator/beam/erl_db_util.c773
-rw-r--r--erts/emulator/beam/erl_db_util.h71
-rw-r--r--erts/emulator/beam/erl_lock_check.c4
-rw-r--r--erts/emulator/beam/erl_monitors.c18
-rw-r--r--erts/emulator/beam/erl_nif.c54
-rw-r--r--erts/emulator/beam/erl_nif.h14
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h17
-rw-r--r--erts/emulator/beam/erl_process.h4
-rw-r--r--erts/emulator/beam/erl_process_dump.c240
-rw-r--r--erts/emulator/beam/erl_term.c49
-rw-r--r--erts/emulator/beam/erl_term.h166
-rw-r--r--erts/emulator/beam/erl_trace.c6
-rw-r--r--erts/emulator/beam/erl_vm.h5
-rw-r--r--erts/emulator/beam/global.h57
-rw-r--r--erts/emulator/beam/sys.h10
-rw-r--r--erts/emulator/beam/utils.c285
-rw-r--r--erts/emulator/sys/common/erl_mseg.c623
-rw-r--r--erts/emulator/sys/unix/sys_float.c7
-rw-r--r--erts/emulator/test/a_SUITE.erl29
-rw-r--r--erts/emulator/test/after_SUITE.erl37
-rw-r--r--erts/emulator/test/alloc_SUITE.erl41
-rw-r--r--erts/emulator/test/beam_SUITE.erl30
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl35
-rw-r--r--erts/emulator/test/bif_SUITE.erl32
-rw-r--r--erts/emulator/test/big_SUITE.erl42
-rw-r--r--erts/emulator/test/binary_SUITE.erl54
-rw-r--r--erts/emulator/test/bs_bincomp_SUITE.erl31
-rw-r--r--erts/emulator/test/bs_bit_binaries_SUITE.erl34
-rw-r--r--erts/emulator/test/bs_construct_SUITE.erl31
-rw-r--r--erts/emulator/test/bs_match_bin_SUITE.erl30
-rw-r--r--erts/emulator/test/bs_match_int_SUITE.erl32
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl36
-rw-r--r--erts/emulator/test/bs_match_tail_SUITE.erl28
-rw-r--r--erts/emulator/test/bs_utf_SUITE.erl36
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl33
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl39
-rw-r--r--erts/emulator/test/code_SUITE.erl32
-rw-r--r--erts/emulator/test/crypto_SUITE.erl30
-rw-r--r--erts/emulator/test/crypto_reference.erl2
-rw-r--r--erts/emulator/test/ddll_SUITE.erl65
-rw-r--r--erts/emulator/test/decode_packet_SUITE.erl28
-rw-r--r--erts/emulator/test/dgawd_handler.erl2
-rw-r--r--erts/emulator/test/distribution_SUITE.erl93
-rw-r--r--erts/emulator/test/driver_SUITE.erl122
-rw-r--r--erts/emulator/test/efile_SUITE.erl28
-rw-r--r--erts/emulator/test/emulator.spec2
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE.erl28
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl40
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl35
-rw-r--r--erts/emulator/test/estone_SUITE.erl32
-rw-r--r--erts/emulator/test/evil_SUITE.erl47
-rw-r--r--erts/emulator/test/exception_SUITE.erl32
-rw-r--r--erts/emulator/test/float_SUITE.erl39
-rw-r--r--erts/emulator/test/fun_SUITE.erl36
-rw-r--r--erts/emulator/test/fun_r12_SUITE.erl29
-rw-r--r--erts/emulator/test/gc_SUITE.erl29
-rw-r--r--erts/emulator/test/guard_SUITE.erl29
-rw-r--r--erts/emulator/test/hash_SUITE.erl38
-rw-r--r--erts/emulator/test/hibernate_SUITE.erl33
-rw-r--r--[l---------]erts/emulator/test/ignore_cores.erl159
-rw-r--r--erts/emulator/test/list_bif_SUITE.erl33
-rw-r--r--erts/emulator/test/long_timers_test.erl2
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl48
-rw-r--r--erts/emulator/test/module_info_SUITE.erl43
-rw-r--r--erts/emulator/test/monitor_SUITE.erl44
-rw-r--r--erts/emulator/test/mtx_SUITE.erl42
-rw-r--r--erts/emulator/test/nested_SUITE.erl30
-rw-r--r--erts/emulator/test/nif_SUITE.erl62
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.erl2
-rw-r--r--erts/emulator/test/nif_SUITE_data/tester.erl2
-rw-r--r--erts/emulator/test/node_container_SUITE.erl56
-rw-r--r--erts/emulator/test/nofrag_SUITE.erl33
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl36
-rw-r--r--erts/emulator/test/old_mod.erl2
-rw-r--r--erts/emulator/test/old_scheduler_SUITE.erl40
-rw-r--r--erts/emulator/test/op_SUITE.erl33
-rw-r--r--erts/emulator/test/port_SUITE.erl66
-rw-r--r--erts/emulator/test/port_bif_SUITE.erl44
-rw-r--r--erts/emulator/test/process_SUITE.erl88
-rw-r--r--erts/emulator/test/pseudoknot_SUITE.erl26
-rw-r--r--erts/emulator/test/random_iolist.erl2
-rw-r--r--erts/emulator/test/receive_SUITE.erl31
-rw-r--r--erts/emulator/test/ref_SUITE.erl31
-rw-r--r--erts/emulator/test/register_SUITE.erl31
-rw-r--r--erts/emulator/test/save_calls_SUITE.erl27
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl58
-rw-r--r--erts/emulator/test/send_term_SUITE.erl29
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl37
-rw-r--r--erts/emulator/test/signal_SUITE.erl45
-rw-r--r--erts/emulator/test/statistics_SUITE.erl46
-rw-r--r--erts/emulator/test/system_info_SUITE.erl31
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl41
-rw-r--r--erts/emulator/test/time_SUITE.erl36
-rw-r--r--erts/emulator/test/timer_bif_SUITE.erl36
-rw-r--r--erts/emulator/test/trace_SUITE.erl42
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl34
-rw-r--r--erts/emulator/test/trace_call_count_SUITE.erl38
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl40
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl58
-rw-r--r--erts/emulator/test/trace_meta_SUITE.erl43
-rw-r--r--erts/emulator/test/trace_nif_SUITE.erl39
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl45
-rw-r--r--erts/emulator/test/tuple_SUITE.erl35
-rw-r--r--erts/emulator/test/z_SUITE.erl38
113 files changed, 4197 insertions, 2043 deletions
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index ff15d834ab..f47f5a9c0c 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -1558,7 +1558,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp)
** Convert a bignum to a double float
*/
int
-big_to_double(Eterm x, double* resp)
+big_to_double(Wterm x, double* resp)
{
double d = 0.0;
Eterm* xp = big_val(x);
@@ -1725,7 +1725,7 @@ static Eterm big_norm(Eterm *x, dsize_t xl, short sign)
/*
** Compare bignums
*/
-int big_comp(Eterm x, Eterm y)
+int big_comp(Wterm x, Wterm y)
{
Eterm* xp = big_val(x);
Eterm* yp = big_val(y);
@@ -2060,7 +2060,7 @@ static Eterm B_plus_minus(ErtsDigit *x, dsize_t xl, short xsgn,
/*
** Add bignums
*/
-Eterm big_plus(Eterm x, Eterm y, Eterm *r)
+Eterm big_plus(Wterm x, Wterm y, Eterm *r)
{
Eterm* xp = big_val(x);
Eterm* yp = big_val(y);
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 25466cd3c2..f28a390aea 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -120,7 +120,7 @@ char *erts_big_to_string(Eterm x, char *buf, Uint buf_sz);
Eterm small_times(Sint, Sint, Eterm*);
-Eterm big_plus(Eterm, Eterm, Eterm*);
+Eterm big_plus(Wterm, Wterm, Eterm*);
Eterm big_minus(Eterm, Eterm, Eterm*);
Eterm big_times(Eterm, Eterm, Eterm*);
Eterm big_div(Eterm, Eterm, Eterm*);
@@ -137,9 +137,9 @@ Eterm big_bxor(Eterm, Eterm, Eterm*);
Eterm big_bnot(Eterm, Eterm*);
Eterm big_lshift(Eterm, Sint, Eterm*);
-int big_comp (Eterm, Eterm);
+int big_comp (Wterm, Wterm);
int big_ucomp (Eterm, Eterm);
-int big_to_double(Eterm x, double* resp);
+int big_to_double(Wterm x, double* resp);
Eterm small_to_big(Sint, Eterm*);
Eterm uint_to_big(Uint, Eterm*);
Eterm uword_to_big(UWord, Eterm*);
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 8bee47232e..243e8973cf 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -72,8 +72,11 @@ copy_object(Eterm obj, Process* to)
* Return the "flat" size of the object.
*/
-Uint
-size_object(Eterm obj)
+#if HALFWORD_HEAP
+Uint size_object_rel(Eterm obj, Eterm* base)
+#else
+Uint size_object(Eterm obj)
+#endif
{
Uint sum = 0;
Eterm* ptr;
@@ -84,7 +87,7 @@ size_object(Eterm obj)
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
- ptr = list_val(obj);
+ ptr = list_val_rel(obj,base);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
@@ -93,11 +96,11 @@ size_object(Eterm obj)
break;
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val(obj);
+ Eterm hdr = *boxed_val_rel(obj,base);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
- ptr = tuple_val(obj);
+ ptr = tuple_val_rel(obj,base);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
@@ -113,7 +116,7 @@ size_object(Eterm obj)
break;
case FUN_SUBTAG:
{
- Eterm* bptr = fun_val(obj);
+ Eterm* bptr = fun_val_rel(obj,base);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
@@ -136,7 +139,7 @@ size_object(Eterm obj)
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
- ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
+ ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
@@ -146,11 +149,11 @@ size_object(Eterm obj)
} else {
extra_bytes = 0;
}
- hdr = *binary_val(real_bin);
+ hdr = *binary_val_rel(real_bin,base);
if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
sum += PROC_BIN_SIZE;
} else {
- sum += heap_bin_size(binary_size(obj)+extra_bytes);
+ sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes);
}
goto pop_next;
}
@@ -181,8 +184,12 @@ size_object(Eterm obj)
/*
* Copy a structure to a heap.
*/
-Eterm
-copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
+#if HALFWORD_HEAP
+Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
+ Eterm* src_base, Eterm* dst_base)
+#else
+Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
+#endif
{
char* hstart;
Uint hsize;
@@ -214,7 +221,10 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
/* Copy the object onto the heap */
switch (primary_tag(obj)) {
- case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list;
+ case TAG_PRIMARY_LIST:
+ argp = &res;
+ objp = list_val_rel(obj,src_base);
+ goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
@@ -231,32 +241,46 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
hp++;
break;
case TAG_PRIMARY_LIST:
- objp = list_val(obj);
+ objp = list_val_rel(obj,src_base);
+ #if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(objp,hstart,hsize)) {
+ ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
+ #endif
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
- while (is_list(obj)) {
- objp = list_val(obj);
+ for (;;) {
tp = tailp;
- elem = *objp;
+ elem = CAR(objp);
if (IS_CONST(elem)) {
- *(hbot-2) = elem;
- tailp = hbot-1;
hbot -= 2;
+ CAR(hbot) = elem;
+ tailp = &CDR(hbot);
}
else {
- *htop = elem;
- tailp = htop+1;
+ CAR(htop) = elem;
+ #if HALFWORD_HEAP
+ CDR(htop) = CDR(objp);
+ *tailp = make_list_rel(htop,dst_base);
+ htop += 2;
+ goto L_copy;
+ #else
+ tailp = &CDR(htop);
htop += 2;
+ #endif
+ }
+ ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
+ *tp = make_list_rel(tailp - 1, dst_base);
+ obj = CDR(objp);
+ if (!is_list(obj)) {
+ break;
}
- *tp = make_list(tailp - 1);
- obj = *(objp+1);
+ objp = list_val_rel(obj,src_base);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
@@ -268,21 +292,24 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
case TAG_PRIMARY_BOXED:
- if (in_area(boxed_val(obj),hstart,hsize)) {
+ #if !HALFWORD_HEAP || defined(DEBUG)
+ if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) {
+ ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
+ #endif
argp = hp++;
L_copy_boxed:
- objp = boxed_val(obj);
+ objp = boxed_val_rel(obj, src_base);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
- *argp = make_tuple(htop);
+ *argp = make_tuple_rel(htop, dst_base);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
@@ -311,7 +338,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
while (i--) {
*tp++ = *objp++;
}
- *argp = make_binary(hbot);
+ *argp = make_binary_rel(hbot, dst_base);
pb = (ProcBin*) hbot;
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->first;
@@ -338,7 +365,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
extra_bytes = 0;
}
real_size = size+extra_bytes;
- objp = binary_val(real_bin);
+ objp = binary_val_rel(real_bin,src_base);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) objp;
ErlHeapBin* to;
@@ -368,7 +395,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*) to;
OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
}
- *argp = make_binary(hbot);
+ *argp = make_binary_rel(hbot, dst_base);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
@@ -380,7 +407,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
res->offs = 0;
res->is_writable = 0;
res->orig = *argp;
- *argp = make_binary(hbot);
+ *argp = make_binary_rel(hbot, dst_base);
}
break;
}
@@ -400,7 +427,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
#endif
- *argp = make_fun(tp);
+ *argp = make_fun_rel(tp, dst_base);
}
break;
case EXTERNAL_PID_SUBTAG:
@@ -420,7 +447,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*)etp;
erts_refc_inc(&etp->node->refc, 2);
- *argp = make_external(tp);
+ *argp = make_external_rel(tp, dst_base);
}
break;
case BIN_MATCHSTATE_SUBTAG:
@@ -430,7 +457,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
- *argp = make_boxed(hbot);
+ *argp = make_boxed_rel(hbot, dst_base);
while (i--) {
*tp++ = *objp++;
}
@@ -885,12 +912,21 @@ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs)
*
* NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr).
*/
-Eterm
-copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
+#if HALFWORD_HEAP
+Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
+ Eterm* src_base)
+#else
+Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
+#endif
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
- Sint offs = hp - tp;
+ const Eterm res = make_tuple(hp);
+#if HALFWORD_HEAP
+ const Sint offs = COMPRESS_POINTER(hp - (tp - src_base));
+#else
+ const Sint offs = (hp - tp) * sizeof(Eterm);
+#endif
while (sz--) {
Eterm val = *tp++;
@@ -901,7 +937,7 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- *hp++ = offset_ptr(val, offs);
+ *hp++ = byte_offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
*hp++ = val;
@@ -958,7 +994,8 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
}
*hpp = hp;
- return make_tuple(ptr + offs);
+
+ return res;
}
/* Move all terms in heap fragments into heap. The terms must be guaranteed to
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index b7b9c6a133..ca71798917 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2010. All Rights Reserved.
+# Copyright Ericsson AB 2003-2011. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -193,6 +193,7 @@ type DB_FIXATION SHORT_LIVED ETS db_fixation
type DB_FIX_DEL SHORT_LIVED ETS fixed_del
type DB_TABLES LONG_LIVED ETS db_tabs
type DB_NTAB_ENT STANDARD ETS db_named_table_entry
+type DB_HEIR_DATA STANDARD ETS db_heir_data
type DB_TMP TEMPORARY ETS db_tmp
type DB_MC_STK TEMPORARY ETS db_mc_stack
type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index ce13469801..47c48e74d6 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -378,7 +378,7 @@ keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List)
Eterm *tuple_ptr = tuple_val(term);
if (pos <= arityval(*tuple_ptr)) {
Eterm element = tuple_ptr[pos];
- if (cmp(Key, element) == 0) {
+ if (CMP(Key, element) == 0) {
return term;
}
}
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index bdf0fe23fc..506c4813fa 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -71,6 +71,7 @@ typedef struct erl_heap_bin {
*/
#define binary_size(Bin) (binary_val(Bin)[1])
+#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1])
#define binary_bitsize(Bin) \
((*binary_val(Bin) == HEADER_SUB_BIN) ? \
@@ -93,9 +94,12 @@ typedef struct erl_heap_bin {
* Bitsize: output variable (Uint)
*/
-#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
+#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
+ ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL)
+
+#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \
do { \
- Eterm* _real_bin = binary_val(Bin); \
+ Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \
Uint _offs = 0; \
Bitoffs = Bitsize = 0; \
if (*_real_bin == HEADER_SUB_BIN) { \
@@ -103,7 +107,7 @@ do { \
_offs = _sb->offs; \
Bitoffs = _sb->bitoffs; \
Bitsize = _sb->bitsize; \
- _real_bin = binary_val(_sb->orig); \
+ _real_bin = binary_val_rel(_sb->orig,BasePtr); \
} \
if (*_real_bin == HEADER_PROC_BIN) { \
Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \
@@ -125,9 +129,12 @@ do { \
* BitSize: Extra bit size (Uint)
*/
-#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \
+#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \
+ ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL)
+
+#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \
do { \
- ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \
+ ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \
if (_sb->thing_word == HEADER_SUB_BIN) { \
RealBin = _sb->orig; \
ByteOffset = _sb->offs; \
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 3173d3510e..5b74240cc3 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -910,7 +910,8 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
Eterm upop;
Eterm* tpl;
Sint position;
- Eterm incr, warp, oldcnt;
+ Eterm incr, warp;
+ Wterm oldcnt;
if (is_not_list(iter)) {
goto finalize;
@@ -985,7 +986,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
Eterm* tpl = tuple_val(CAR(list_val(iter)));
Sint position = signed_val(tpl[1]);
Eterm incr = tpl[2];
- Eterm oldcnt = handle.dbterm->tpl[position];
+ Wterm oldcnt = db_do_read_element(&handle,position);
Eterm newcnt = db_add_counter(&htop, oldcnt, incr);
if (newcnt == NIL) {
@@ -998,9 +999,9 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
if (arityval(*tpl) == 4) { /* Maybe warp it */
Eterm threshold = tpl[3];
- if ((cmp(incr,make_small(0)) < 0) ? /* negative increment? */
- (cmp(newcnt,threshold) < 0) : /* if negative, check if below */
- (cmp(newcnt,threshold) > 0)) { /* else check if above threshold */
+ if ((CMP(incr,make_small(0)) < 0) ? /* negative increment? */
+ (CMP(newcnt,threshold) < 0) : /* if negative, check if below */
+ (CMP(newcnt,threshold) > 0)) { /* else check if above threshold */
newcnt = tpl[4];
}
@@ -2712,7 +2713,6 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
Binary *mp;
Eterm res;
Uint32 dummy;
- Uint sz;
if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) {
error:
@@ -2737,11 +2737,10 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3],
BIF_P,lst,BIF_ARG_2,ret);
}
- res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, &dummy);
+ res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0,
+ ERTS_PAM_COPY_RESULT, &dummy);
if (is_value(res)) {
- sz = size_object(res);
- hp = HAlloc(BIF_P, sz + 2);
- res = copy_struct(res, sz, &hp, &MSO(BIF_P));
+ hp = HAlloc(BIF_P, 2);
ret = CONS(hp,res,ret);
/*hp += 2;*/
}
@@ -3490,11 +3489,24 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data)
if (!is_immed(heir_data)) {
DeclareTmpHeap(tmp,2,me);
+ Eterm wrap_tpl;
+ int size;
+ DbTerm* dbterm;
+ Eterm* top;
+ ErlOffHeap tmp_offheap;
UseTmpHeap(2,me);
- /* Make a dummy 1-tuple around data to use db_get_term() */
- heir_data = (UWord) db_store_term(&tb->common, NULL, 0,
- TUPLE1(tmp,heir_data));
+ /* Make a dummy 1-tuple around data to use DbTerm */
+ wrap_tpl = TUPLE1(tmp,heir_data);
+ size = size_object(wrap_tpl);
+ dbterm = erts_db_alloc(ERTS_ALC_T_DB_HEIR_DATA, (DbTable *)tb,
+ (sizeof(DbTerm) + sizeof(Eterm)*(size-1)));
+ dbterm->size = size;
+ top = dbterm->tpl;
+ tmp_offheap.first = NULL;
+ copy_struct(wrap_tpl, size, &top, &tmp_offheap);
+ dbterm->first_oh = tmp_offheap.first;
+ heir_data = (UWord)dbterm;
UnUseTmpHeap(2,me);
ASSERT(!is_immed(heir_data));
}
@@ -3506,7 +3518,7 @@ static void free_heir_data(DbTable* tb)
if (tb->common.heir != am_none && !is_immed(tb->common.heir_data)) {
DbTerm* p = (DbTerm*) tb->common.heir_data;
db_cleanup_offheap_comp(p);
- erts_db_free(ERTS_ALC_T_DB_TERM, tb, (void *)p,
+ erts_db_free(ERTS_ALC_T_DB_HEIR_DATA, tb, (void *)p,
sizeof(DbTerm) + (p->size-1)*sizeof(Eterm));
}
#ifdef DEBUG
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 1e50fee554..9ef990cc4f 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -258,12 +258,6 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix,
}
-/*
- * tplp is an untagged pointer to a tuple we know is large enough
- * and dth is a pointer to a DbTableHash.
- */
-#define GETKEY(dth, tplp) (*((tplp) + (dth)->common.keypos))
-
/*
* Some special binary flags
*/
@@ -434,6 +428,9 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb)
}
}
+#define EQ_REL(x,y,y_base) \
+ (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base)))
+
/* Is this a live object (not pseodo-deleted) with the specified key?
*/
static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
@@ -443,7 +440,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ(key,itemKey);
+ return EQ_REL(key, itemKey, b->dbterm.tpl);
}
}
@@ -456,7 +453,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ(key,itemKey);
+ return EQ_REL(key, itemKey, b->dbterm.tpl);
}
}
@@ -696,9 +693,7 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
}
}
if (list != NULL) {
- Eterm key = GETKEY(tb, list->dbterm.tpl);
-
- COPY_OBJECT(key, p, ret);
+ *ret = db_copy_key(p, tbl, &list->dbterm);
RUNLOCK_HASH(lck);
}
else {
@@ -746,7 +741,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
*ret = am_EOT;
}
else {
- COPY_OBJECT(GETKEY(tb, b->dbterm.tpl), p, ret);
+ *ret = db_copy_key(p, tbl, &b->dbterm);
RUNLOCK_HASH(lck);
}
return DB_ERROR_NONE;
@@ -1308,8 +1303,8 @@ static int db_select_continue_hash(Process *p,
}
for(;;) {
if (current->hvalue != INVALID_HASH &&
- (match_res = db_prog_match_and_copy(&tb->common, p, mp, all_objects,
- &current->dbterm, &hp, 2),
+ (match_res = db_match_dbterm(&tb->common, p, mp, all_objects,
+ &current->dbterm, &hp, 2),
is_value(match_res))) {
match_list = CONS(hp, match_res, match_list);
@@ -1473,8 +1468,8 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl,
for(;;) {
if (current != NULL) {
if (current->hvalue != INVALID_HASH) {
- match_res = db_prog_match_and_copy(&tb->common, p, mpi.mp, 0,
- &current->dbterm, &hp, 2);
+ match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0,
+ &current->dbterm, &hp, 2);
if (is_value(match_res)) {
match_list = CONS(hp, match_res, match_list);
++got;
@@ -1639,8 +1634,8 @@ static int db_select_count_hash(Process *p,
for(;;) {
if (current != NULL) {
if (current->hvalue != INVALID_HASH) {
- if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0,
- &current->dbterm, NULL,0) == am_true) {
+ if (db_match_dbterm(&tb->common, p, mpi.mp, 0,
+ &current->dbterm, NULL,0) == am_true) {
++got;
}
--num_left;
@@ -1788,8 +1783,8 @@ static int db_select_delete_hash(Process *p,
}
else {
int did_erase = 0;
- if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0,
- &(*current)->dbterm, NULL, 0) == am_true) {
+ if (db_match_dbterm(&tb->common, p, mpi.mp, 0,
+ &(*current)->dbterm, NULL, 0) == am_true) {
if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
if (slot_ix != last_pseudo_delete) {
add_fixed_deletion(tb, slot_ix);
@@ -1899,8 +1894,8 @@ static int db_select_delete_continue_hash(Process *p,
}
else {
int did_erase = 0;
- if (db_prog_match_and_copy(&tb->common, p, mp, 0,
- &(*current)->dbterm, NULL, 0) == am_true) {
+ if (db_match_dbterm(&tb->common, p, mp, 0,
+ &(*current)->dbterm, NULL, 0) == am_true) {
if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
if (slot_ix != last_pseudo_delete) {
add_fixed_deletion(tb, slot_ix);
@@ -1999,8 +1994,8 @@ static int db_select_count_continue_hash(Process *p,
current = current->next;
continue;
}
- if (db_prog_match_and_copy(&tb->common, p, mp, 0, &current->dbterm,
- NULL, 0) == am_true) {
+ if (db_match_dbterm(&tb->common, p, mp, 0, &current->dbterm,
+ NULL, 0) == am_true) {
++got;
}
--num_left;
@@ -2179,7 +2174,7 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
HashValue hval = NIL;
int num_heads = 0;
int i;
-
+
mpi->lists = mpi->dlists;
mpi->num_lists = 0;
mpi->key_given = 1;
@@ -2695,6 +2690,9 @@ static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle
handle->dbterm = &b->dbterm;
handle->mustResize = 0;
handle->new_size = b->dbterm.size;
+ #if HALFWORD_HEAP
+ handle->abs_vec = NULL;
+ #endif
handle->lck = lck;
/* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */
return 1;
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 8108494fc5..484a096249 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -48,9 +48,6 @@
#include "erl_db_tree.h"
-
-
-#define GETKEY(dtt, tplp) (*((tplp) + (dtt)->common.keypos))
#define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos))
#define NITEMS(tb) ((int)erts_smp_atomic_read(&(tb)->common.nitems))
@@ -282,7 +279,7 @@ struct select_delete_context {
/*
** Forward declarations
*/
-static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key);
+static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base);
static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
Eterm object);
static int do_free_tree_cont(DbTableTree *tb, int num_left);
@@ -293,15 +290,15 @@ static int delsub(TreeDbTerm **this);
static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot);
static TreeDbTerm *find_node(DbTableTree *tb, Eterm key);
static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key);
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key);
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key);
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static void traverse_backwards(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey,
+ Eterm lastkey, Eterm* lk_base,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -309,7 +306,7 @@ static void traverse_backwards(DbTableTree *tb,
void *context);
static void traverse_forward(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey,
+ Eterm lastkey, Eterm* lk_base,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -317,8 +314,8 @@ static void traverse_forward(DbTableTree *tb,
void *context);
static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
Eterm *partly_bound_key);
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key);
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done);
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base);
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done);
static int analyze_pattern(DbTableTree *tb, Eterm pattern,
struct mp_info *mpi);
@@ -492,9 +489,6 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret)
DbTableTree *tb = &tbl->tree;
DbTreeStack* stack;
TreeDbTerm *this;
- Eterm e;
- Eterm *hp;
- Uint sz;
if (( this = tb->root ) == NULL) {
*ret = am_EOT;
@@ -513,13 +507,7 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret)
stack->slot = 1;
release_stack(tb,stack);
}
- e = GETKEY(tb, this->dbterm.tpl);
- sz = size_object(e);
-
- hp = HAlloc(p, sz);
-
- *ret = copy_struct(e,sz,&hp,&MSO(p));
-
+ *ret = db_copy_key(p, tbl, &this->dbterm);
return DB_ERROR_NONE;
}
@@ -528,26 +516,17 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
DbTableTree *tb = &tbl->tree;
DbTreeStack* stack;
TreeDbTerm *this;
- Eterm e;
- Eterm *hp;
- Uint sz;
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_next(tb, stack, key);
+ this = find_next(tb, stack, key, NULL);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
return DB_ERROR_NONE;
}
- e = GETKEY(tb, this->dbterm.tpl);
- sz = size_object(e);
-
- hp = HAlloc(p, sz);
-
- *ret = copy_struct(e,sz,&hp,&MSO(p));
-
+ *ret = db_copy_key(p, tbl, &this->dbterm);
return DB_ERROR_NONE;
}
@@ -556,9 +535,6 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret)
DbTableTree *tb = &tbl->tree;
TreeDbTerm *this;
DbTreeStack* stack;
- Eterm e;
- Eterm *hp;
- Uint sz;
if (( this = tb->root ) == NULL) {
*ret = am_EOT;
@@ -577,13 +553,7 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret)
stack->slot = NITEMS(tb);
release_stack(tb,stack);
}
- e = GETKEY(tb, this->dbterm.tpl);
- sz = size_object(e);
-
- hp = HAlloc(p, sz);
-
- *ret = copy_struct(e,sz,&hp,&MSO(p));
-
+ *ret = db_copy_key(p, tbl, &this->dbterm);
return DB_ERROR_NONE;
}
@@ -592,27 +562,33 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
DbTableTree *tb = &tbl->tree;
TreeDbTerm *this;
DbTreeStack* stack;
- Eterm e;
- Eterm *hp;
- Uint sz;
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_prev(tb, stack, key);
+ this = find_prev(tb, stack, key, NULL);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
return DB_ERROR_NONE;
}
- e = GETKEY(tb, this->dbterm.tpl);
- sz = size_object(e);
+ *ret = db_copy_key(p, tbl, &this->dbterm);
+ return DB_ERROR_NONE;
+}
- hp = HAlloc(p, sz);
+static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
+ TreeDbTerm* obj)
+{
+ return cmp_rel(key, key_base,
+ GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl);
+}
- *ret = copy_struct(e,sz,&hp,&MSO(p));
-
- return DB_ERROR_NONE;
+static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base,
+ TreeDbTerm* obj)
+{
+ Eterm obj_key = GETKEY(tb,obj->dbterm.tpl);
+ return is_same(key, key_base, obj_key, obj->dbterm.tpl)
+ || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0;
}
static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
@@ -646,8 +622,8 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
(*this)->balance = 0;
(*this)->left = (*this)->right = NULL;
break;
- } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) {
- /* go left */
+ } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) {
+ /* go lefts */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -801,7 +777,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret)
*ret = am_true;
- if ((res = linkout_tree(tb, key)) != NULL) {
+ if ((res = linkout_tree(tb, key, NULL)) != NULL) {
free_term(tb, res);
}
return DB_ERROR_NONE;
@@ -993,15 +969,15 @@ static int db_select_continue_tree(Process *p,
stack = get_any_stack(tb);
if (chunk_size) {
if (reverse) {
- traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
} else {
- traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
}
} else {
if (reverse) {
- traverse_forward(tb, stack, lastkey, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc);
} else {
- traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc);
}
}
release_stack(tb,stack);
@@ -1026,10 +1002,9 @@ static int db_select_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
-
- sz = size_object(key);
+ sz = size_object_rel(key,sc.lastobj);
hp = HAlloc(p, 9 + sz);
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
continuation = TUPLE8
(hp,
tptr[1],
@@ -1050,8 +1025,8 @@ static int db_select_continue_tree(Process *p,
key = GETKEY(tb, sc.lastobj);
if (chunk_size) {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key) < 0) ||
- (reverse && cmp_partly_bound(end_condition,key) > 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) ||
+ (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) {
/* done anyway */
if (!sc.got) {
RET_TO_BIF(am_EOT, DB_ERROR_NONE);
@@ -1063,16 +1038,16 @@ static int db_select_continue_tree(Process *p,
}
} else {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key) > 0) ||
- (reverse && cmp_partly_bound(end_condition,key) < 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) ||
+ (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) {
/* done anyway */
RET_TO_BIF(sc.accum,DB_ERROR_NONE);
}
}
/* Not done yet, let's trap. */
- sz = size_object(key);
+ sz = size_object_rel(key,sc.lastobj);
hp = HAlloc(p, 9 + sz);
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
continuation = TUPLE8
(hp,
tptr[1],
@@ -1099,6 +1074,7 @@ static int db_select_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
+ Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1140,7 +1116,7 @@ static int db_select_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- cmp(mpi.least,mpi.most) == 0) {
+ CMP(mpi.least,mpi.most) == 0) {
doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */);
RET_TO_BIF(sc.accum,DB_ERROR_NONE);
}
@@ -1150,20 +1126,20 @@ static int db_select_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
-
- traverse_forward(tb, stack, lastkey, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
-
- traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc);
}
release_stack(tb,stack);
#ifdef HARDDEBUG
@@ -1176,9 +1152,9 @@ static int db_select_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastobj);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb=db_make_mp_binary(p,mpi.mp,&hp);
@@ -1259,7 +1235,7 @@ static int db_select_count_continue_tree(Process *p,
}
stack = get_any_stack(tb);
- traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
@@ -1269,12 +1245,12 @@ static int db_select_count_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
if (end_condition != NIL &&
- (cmp_partly_bound(end_condition,key) > 0)) {
+ (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) {
/* done anyway */
RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastobj);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + 6);
egot = make_small(sc.got);
@@ -1284,7 +1260,7 @@ static int db_select_count_continue_tree(Process *p,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
continuation = TUPLE5
(hp,
tptr[1],
@@ -1307,6 +1283,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
struct select_count_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
+ Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1347,7 +1324,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- cmp(mpi.least,mpi.most) == 0) {
+ CMP(mpi.least,mpi.most) == 0) {
doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */);
RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE);
}
@@ -1356,11 +1333,12 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1368,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastobj);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
egot = make_small(sc.got);
@@ -1378,7 +1356,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1409,6 +1387,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
+ Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1450,7 +1429,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- cmp(mpi.least,mpi.most) == 0) {
+ CMP(mpi.least,mpi.most) == 0) {
doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */);
if (sc.accum != NIL) {
hp=HAlloc(p, 3);
@@ -1465,20 +1444,20 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
-
- traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
-
- traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
}
release_stack(tb,stack);
@@ -1503,9 +1482,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastobj);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1528,9 +1507,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastobj);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
@@ -1606,7 +1585,7 @@ static int db_select_delete_continue_tree(Process *p,
sc.keypos = tb->common.keypos;
ASSERT(!erts_smp_atomic_read(&tb->is_stack_busy));
- traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
@@ -1615,11 +1594,11 @@ static int db_select_delete_continue_tree(Process *p,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
if (end_condition != NIL &&
- cmp_partly_bound(end_condition,key) > 0) { /* done anyway */
+ cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */
RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + 6);
eaccsum = make_small(sc.accum);
@@ -1629,7 +1608,7 @@ static int db_select_delete_continue_tree(Process *p,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
continuation = TUPLE5
(hp,
tptr[1],
@@ -1650,6 +1629,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
struct select_delete_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
+ Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1693,7 +1673,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
sc.mp = mpi.mp;
if (!mpi.got_partial && mpi.some_limitation &&
- cmp(mpi.least,mpi.most) == 0) {
+ CMP(mpi.least,mpi.most) == 0) {
doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't
matter */);
RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE);
@@ -1702,11 +1682,12 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
+ lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1714,7 +1695,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
- sz = size_object(key);
+ sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
eaccsum = make_small(sc.accum);
@@ -1724,7 +1705,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct(key, sz, &hp, &MSO(p));
+ key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
mpb = db_make_mp_binary(p,mpi.mp,&hp);
continuation = TUPLE5
@@ -1842,7 +1823,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt,
}
static TreeDbTerm *linkout_tree(DbTableTree *tb,
- Eterm key)
+ Eterm key, Eterm* key_base)
{
TreeDbTerm **tstack[STACK_NEED];
int tpos = 0;
@@ -1865,7 +1846,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) {
+ } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -1929,7 +1910,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) {
+ } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -2324,14 +2305,15 @@ done:
* Find next and previous in sort order
*/
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key)
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
+ Eterm key, Eterm* key_base)
{
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) {
+ if (!cmp_key_eq(tb,key,key_base,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2341,14 +2323,14 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key)
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) < 0) {
+ if (( c = cmp_key(tb,key,key_base,this) ) > 0) {
if (this->right == NULL) /* We are at the previos
and the element does
not exist */
break;
else
this = this->right;
- } else if (c > 0) {
+ } else if (c < 0) {
if (this->left == NULL) /* Done */
return this;
else
@@ -2381,14 +2363,15 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key)
return this;
}
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key)
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack,
+ Eterm key, Eterm* key_base)
{
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) {
+ if (!cmp_key_eq(tb,key,key_base,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2398,14 +2381,14 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key)
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) > 0) {
+ if (( c = cmp_key(tb,key,key_base,this) ) < 0) {
if (this->left == NULL) /* We are at the next
and the element does
not exist */
break;
else
this = this->left;
- } else if (c < 0) {
+ } else if (c > 0) {
if (this->right == NULL) /* Done */
return this;
else
@@ -2451,7 +2434,8 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) >= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
+ this->dbterm.tpl) ) >= 0) {
if (this->right == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2484,7 +2468,8 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) <= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
+ this->dbterm.tpl) ) <= 0) {
if (this->left == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2514,12 +2499,11 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key)
Sint res;
DbTreeStack* stack = get_static_stack(tb);
- if(!stack || EMPTY_NODE(stack)
- || !CMP_EQ(GETKEY(tb, ( this = TOP_NODE(stack) )->dbterm.tpl), key)) {
+ if(!stack || EMPTY_NODE(stack)
+ || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) {
this = tb->root;
- while (this != NULL &&
- ( res = cmp(key, GETKEY(tb, this->dbterm.tpl)) ) != 0) {
+ while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) {
if (res < 0)
this = this->left;
else
@@ -2541,8 +2525,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key)
Sint res;
this = &tb->root;
- while ((*this) != NULL &&
- ( res = cmp(key, GETKEY(tb, (*this)->dbterm.tpl)) ) != 0) {
+ while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) {
if (res < 0)
this = &((*this)->left);
else
@@ -2565,6 +2548,9 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle
handle->mustResize = 0;
handle->bp = (void**) pp;
handle->new_size = (*pp)->dbterm.size;
+#if HALFWORD_HEAP
+ handle->abs_vec = NULL;
+#endif
return 1;
}
@@ -2589,7 +2575,7 @@ static void db_finalize_dbterm_tree(DbUpdateHandle* handle)
*/
static void traverse_backwards(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey,
+ Eterm lastkey, Eterm* lk_base,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2608,15 +2594,16 @@ static void traverse_backwards(DbTableTree *tb,
this = this->right;
}
this = TOP_NODE(stack);
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl),
+ this->dbterm.tpl);
if (!((*doit)(tb, this, context, 0)))
return;
} else {
- next = find_prev(tb, stack, lastkey);
+ next = find_prev(tb, stack, lastkey, lk_base);
}
while ((this = next) != NULL) {
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
if (!((*doit)(tb, this, context, 0)))
return;
}
@@ -2627,7 +2614,7 @@ static void traverse_backwards(DbTableTree *tb,
*/
static void traverse_forward(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey,
+ Eterm lastkey, Eterm* lk_base,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2646,15 +2633,15 @@ static void traverse_forward(DbTableTree *tb,
this = this->left;
}
this = TOP_NODE(stack);
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
if (!((*doit)(tb, this, context, 1)))
return;
} else {
- next = find_next(tb, stack, lastkey);
+ next = find_next(tb, stack, lastkey, lk_base);
}
while ((this = next) != NULL) {
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
if (!((*doit)(tb, this, context, 1)))
return;
}
@@ -2680,7 +2667,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
if (( this = find_node(tb, key) ) == NULL) {
return -1;
}
- *ret = this;
+ *ret = this;
return 1;
} else if (partly_bound != NULL && key != am_Underscore &&
db_is_variable(key) < 0)
@@ -2691,7 +2678,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done)
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
{
Eterm* aa;
Eterm* bb;
@@ -2705,44 +2692,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done)
*done = 1;
return 0;
}
- if (a == b)
+ if (is_same(a,NULL,b,b_base))
return 0;
switch (a & _TAG_PRIMARY_MASK) {
case TAG_PRIMARY_LIST:
if (!is_list(b)) {
- return cmp(a,b);
+ return cmp_rel(a,NULL,b,b_base);
}
aa = list_val(a);
- bb = list_val(b);
+ bb = list_val_rel(b,b_base);
while (1) {
- if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done)
+ if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done)
return j;
if (*aa==*bb)
return 0;
if (is_not_list(*aa) || is_not_list(*bb))
- return do_cmp_partly_bound(*aa, *bb, done);
+ return do_cmp_partly_bound(*aa, *bb, b_base, done);
aa = list_val(*aa);
- bb = list_val(*bb);
+ bb = list_val_rel(*bb,b_base);
}
case TAG_PRIMARY_BOXED:
if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) {
- return cmp(a,b);
+ return cmp_rel(a,NULL,b,b_base);
}
a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
- b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
+ b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
if (a_hdr != b_hdr) {
- return cmp(a, b);
+ return cmp_rel(a, NULL, b, b_base);
}
if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) {
aa = tuple_val(a);
- bb = tuple_val(b);
+ bb = tuple_val_rel(b, b_base);
/* compare the arities */
i = arityval(*aa); /* get the arity*/
if (i < arityval(*bb)) return(-1);
if (i > arityval(*bb)) return(1);
while (i--) {
- if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0
+ if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0
|| *done)
return j;
}
@@ -2750,14 +2737,14 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done)
}
/* Drop through */
default:
- return cmp(a, b);
+ return cmp_rel(a, NULL, b, b_base);
}
}
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key)
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base)
{
int done = 0;
- Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done);
+ Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done);
#ifdef HARDDEBUG
erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key);
if (ret < 0)
@@ -2766,7 +2753,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key)
erts_fprintf(stderr," > ");
else
erts_fprintf(stderr," == ");
- erts_fprintf(stderr,"%T\n",bound_key);
+ erts_fprintf(stderr,"%T\n",bound_key); // HALFWORD BUG: printing rterm
#endif
return ret;
}
@@ -2853,7 +2840,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b,
if (not_eq_tags(a,b)) {
*done = 1;
- return (cmp(a, b) < 0) ? 1 : 0;
+ return (CMP(a, b) < 0) ? 1 : 0;
}
/* we now know that tags are the same */
@@ -2889,7 +2876,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b,
bb = list_val(*bb);
}
default:
- if((i = cmp(a, b)) != 0) {
+ if((i = CMP(a, b)) != 0) {
*done = 1;
}
return (i < 0) ? 1 : 0;
@@ -2924,7 +2911,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b,
if (not_eq_tags(a,b)) {
*done = 1;
- return (cmp(a, b) > 0) ? 1 : 0;
+ return (CMP(a, b) > 0) ? 1 : 0;
}
/* we now know that tags are the same */
@@ -2960,7 +2947,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b,
bb = list_val(*bb);
}
default:
- if((i = cmp(a, b)) != 0) {
+ if((i = CMP(a, b)) != 0) {
*done = 1;
}
return (i > 0) ? 1 : 0;
@@ -2983,16 +2970,16 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) > 0))) {
return 0;
}
- ret = db_prog_match_and_copy(&tb->common,sc->p,sc->mp,sc->all_objects,
- &this->dbterm, &hp, 2);
+ ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects,
+ &this->dbterm, &hp, 2);
if (is_value(ret)) {
sc->accum = CONS(hp, ret, sc->accum);
}
@@ -3020,12 +3007,12 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr,
/* Always backwards traversing */
if (sc->end_condition != NIL &&
(cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) > 0)) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) > 0)) {
return 0;
}
- ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0,
- &this->dbterm, NULL, 0);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
+ &this->dbterm, NULL, 0);
if (ret == am_true) {
++(sc->got);
}
@@ -3047,17 +3034,17 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) > 0))) {
return 0;
}
- ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, sc->all_objects,
- &this->dbterm, &hp, 2);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, sc->all_objects,
+ &this->dbterm, &hp, 2);
if (is_value(ret)) {
++(sc->got);
sc->accum = CONS(hp, ret, sc->accum);
@@ -3090,14 +3077,14 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos,
- this->dbterm.tpl)) > 0)
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
+ this->dbterm.tpl) > 0)
return 0;
- ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0,
- &this->dbterm, NULL, 0);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
+ &this->dbterm, NULL, 0);
if (ret == am_true) {
key = GETKEY(sc->tb, this->dbterm.tpl);
- linkout_tree(sc->tb, key);
+ linkout_tree(sc->tb, key, this->dbterm.tpl);
sc->erase_lastterm = 1;
++sc->accum;
}
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 2852fb93fe..d3e31da413 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -57,6 +57,7 @@
DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY
+#define HEAP_XTRA 100
/*
** Some convenience macros for stacks (DMC == db_match_compile)
@@ -229,6 +230,11 @@ typedef enum {
matchCall2,
matchCall3,
matchPushV,
+#if HALFWORD_HEAP
+ matchPushVGuard, /* First guard-only variable reference */
+#endif
+ matchPushVResult, /* First variable reference in result, or (if HALFWORD)
+ in guard if also referenced in result */
matchPushExpr, /* Push the whole expression we're matching ('$_') */
matchPushArrayAsList, /* Only when parameter is an Array and
not an erlang term (DCOMP_TRACE) */
@@ -292,11 +298,19 @@ DMC_DECLARE_STACK_TYPE(unsigned);
** Data about the heap during compilation
*/
+typedef struct DMCVariable {
+ int is_bound;
+ int is_in_body;
+#if HALFWORD_HEAP
+ int first_guard_label; /* to maybe change from PushVGuard to PushVResult */
+#endif
+} DMCVariable;
+
typedef struct DMCHeap {
int size;
- unsigned def[DMC_DEFAULT_SIZE];
- unsigned *data;
- int used;
+ DMCVariable vars_def[DMC_DEFAULT_SIZE];
+ DMCVariable* vars;
+ int vars_used;
} DMCHeap;
/*
@@ -323,7 +337,6 @@ typedef struct dmc_context {
Eterm *bodyexpr;
int num_match;
int current_match;
- int eheap_need;
Uint cflags;
int is_guard; /* 1 if in guard, 0 if in body */
int special; /* 1 if the head in the match was a single expression */
@@ -346,9 +359,22 @@ typedef struct dmc_context {
#define ERTS_DEFAULT_MS_HEAP_SIZE 128
+/* Runtime info about a $-variable
+*/
+typedef struct MatchVariable {
+ Eterm term;
+#ifdef DEBUG
+ Process* proc;
+ Eterm* base;
+#endif
+} MatchVariable;
+
typedef struct {
Process process;
- Eterm *heap;
+ union {
+ Eterm* heap;
+ MatchVariable* variables; /* first on "heap" */
+ }u;
Eterm default_heap[ERTS_DEFAULT_MS_HEAP_SIZE];
} ErtsMatchPseudoProcess;
@@ -371,10 +397,10 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap)
}
#endif
if (!keep_heap) {
- if (mpsp->heap != &mpsp->default_heap[0]) {
+ if (mpsp->u.heap != mpsp->default_heap) {
/* Have to be done *after* call to erts_cleanup_empty_process() */
- erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->heap);
- mpsp->heap = &mpsp->default_heap[0];
+ erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->u.heap);
+ mpsp->u.heap = mpsp->default_heap;
}
#ifdef DEBUG
else {
@@ -398,7 +424,7 @@ create_match_pseudo_process(void)
mpsp = (ErtsMatchPseudoProcess *)erts_alloc(ERTS_ALC_T_DB_MS_PSDO_PROC,
sizeof(ErtsMatchPseudoProcess));
erts_init_empty_process(&mpsp->process);
- mpsp->heap = &mpsp->default_heap[0];
+ mpsp->u.heap = mpsp->default_heap;
return mpsp;
}
@@ -422,11 +448,11 @@ get_match_pseudo_process(Process *c_p, Uint heap_size)
mpsp = match_pseudo_process;
cleanup_match_pseudo_process(mpsp, 0);
#endif
- if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE)
- mpsp->heap = (Eterm *) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP,
- heap_size*sizeof(Uint));
+ if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE*sizeof(Eterm)) {
+ mpsp->u.heap = (Eterm*) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, heap_size);
+ }
else {
- ASSERT(mpsp->heap == &mpsp->default_heap[0]);
+ ASSERT(mpsp->u.heap == mpsp->default_heap);
}
return mpsp;
}
@@ -467,23 +493,6 @@ erts_match_set_release_result(Process* c_p)
static erts_smp_atomic_t trace_control_word;
-
-Eterm
-erts_ets_copy_object(Eterm obj, Process* to)
-{
- Uint size = size_object(obj);
- Eterm* hp = HAlloc(to, size);
- Eterm res;
-
- res = copy_struct(obj, size, &hp, &MSO(to));
-#ifdef DEBUG
- if (eq(obj, res) == 0) {
- erl_exit(1, "copy not equal to source\n");
- }
-#endif
- return res;
-}
-
/* This needs to be here, before the bif table... */
static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val);
@@ -869,9 +878,9 @@ static DMCRet dmc_one_term(DMCContext *context,
#ifdef DMC_DEBUG
static int test_disassemble_next = 0;
-static void db_match_dis(Binary *prog);
+void db_match_dis(Binary *prog);
#define TRACE erts_fprintf(stderr,"Trace: %s:%d\n",__FILE__,__LINE__)
-#define FENCE_PATTERN_SIZE 1
+#define FENCE_PATTERN_SIZE (1*sizeof(Uint))
#define FENCE_PATTERN 0xDEADBEEFUL
#else
#define TRACE /* Nothing */
@@ -1179,14 +1188,14 @@ done:
}
Eterm erts_match_set_run(Process *p, Binary *mpsp,
- Eterm *args, int num_args,
+ Eterm *args, int num_args,
+ enum erts_pam_run_flags in_flags,
Uint32 *return_flags)
{
Eterm ret;
- ret = db_prog_match(p, mpsp,
- NIL, args,
- num_args, return_flags);
+ ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args,
+ in_flags, return_flags);
#if defined(HARDDEBUG)
if (is_non_value(ret)) {
erts_fprintf(stderr, "Failed\n");
@@ -1210,9 +1219,9 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp,
{
Eterm ret;
- ret = db_prog_match(p, mpsp,
- args, NULL,
- num_args, return_flags);
+ ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args,
+ ERTS_PAM_CONTIGUOUS_TUPLE | ERTS_PAM_COPY_RESULT,
+ return_flags);
#if defined(HARDDEBUG)
if (is_non_value(ret)) {
erts_fprintf(stderr, "Failed\n");
@@ -1280,7 +1289,6 @@ Binary *db_match_compile(Eterm *matchexpr,
int structure_checked;
DMCRet res;
int current_try_label;
- Uint max_eheap_need;
Binary *bp = NULL;
unsigned clause_start;
@@ -1293,27 +1301,24 @@ Binary *db_match_compile(Eterm *matchexpr,
context.matchexpr = matchexpr;
context.guardexpr = guards;
context.bodyexpr = body;
- context.eheap_need = 0;
context.err_info = err_info;
context.cflags = flags;
heap.size = DMC_DEFAULT_SIZE;
- heap.data = heap.def;
+ heap.vars = heap.vars_def;
/*
** Compile the match expression
*/
restart:
- heap.used = 0;
- max_eheap_need = 0;
+ heap.vars_used = 0;
for (context.current_match = 0;
context.current_match < num_progs;
++context.current_match) { /* This loop is long,
too long */
- memset(heap.data, 0, heap.size * sizeof(*heap.data));
+ memset(heap.vars, 0, heap.size * sizeof(*heap.vars));
t = context.matchexpr[context.current_match];
context.stack_used = 0;
- context.eheap_need = 0;
structure_checked = 0;
if (context.current_match < num_progs - 1) {
DMC_PUSH(text,matchTryMeElse);
@@ -1485,10 +1490,6 @@ restart:
if (current_try_label >= 0) {
DMC_POKE(text, current_try_label, DMC_STACK_NUM(text));
}
- /* So, how much eheap did this part of the match program need? */
- if (context.eheap_need > max_eheap_need) {
- max_eheap_need = context.eheap_need;
- }
} /* for (context.current_match = 0 ...) */
@@ -1524,16 +1525,13 @@ restart:
ret->saved_program_buf = NULL;
ret->saved_program = NIL;
ret->term_save = context.save;
- ret->num_bindings = heap.used;
+ ret->num_bindings = heap.vars_used;
ret->single_variable = context.special;
sys_memcpy(ret->text, DMC_STACK_DATA(text),
DMC_STACK_NUM(text) * sizeof(UWord));
- ret->heap_size = ((heap.used * sizeof(Eterm)) +
- (max_eheap_need * sizeof(Eterm)) +
- (context.stack_need * sizeof(Eterm *)) +
- (3 * (FENCE_PATTERN_SIZE * sizeof(Eterm *))));
- ret->eheap_offset = heap.used + FENCE_PATTERN_SIZE;
- ret->stack_offset = ret->eheap_offset + max_eheap_need + FENCE_PATTERN_SIZE;
+ ret->stack_offset = heap.vars_used*sizeof(MatchVariable) + FENCE_PATTERN_SIZE;
+ ret->heap_size = ret->stack_offset + context.stack_need * sizeof(Eterm*) + FENCE_PATTERN_SIZE;
+
#ifdef DMC_DEBUG
ret->prog_end = ret->text + DMC_STACK_NUM(text);
#endif
@@ -1551,8 +1549,8 @@ error: /* Here is were we land when compilation failed. */
DMC_FREE(text);
if (context.copy != NULL)
free_message_buffer(context.copy);
- if (heap.data != heap.def)
- erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.data);
+ if (heap.vars != heap.vars_def)
+ erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.vars);
return bp;
}
@@ -1597,7 +1595,7 @@ erts_match_prog_foreach_offheap(Binary *bprog,
*/
static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
{
- Eterm *hp = HAlloc(psp, arity * 2);
+ Eterm *hp = HAllocX(psp, arity * 2, HEAP_XTRA);
Eterm ret = NIL;
while (--arity >= 0) {
ret = CONS(hp, arr[arity], ret);
@@ -1606,15 +1604,82 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
return ret;
}
+
+#if HALFWORD_HEAP
+struct heap_checkpoint_t
+{
+ Process *p;
+ Eterm* htop;
+ ErlHeapFragment* mbuf;
+ unsigned used_size;
+ ErlOffHeap off_heap;
+};
+
+static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp)
+{
+ hcp->p = p;
+ hcp->htop = HEAP_TOP(p);
+ hcp->mbuf = MBUF(p);
+ hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0;
+ hcp->off_heap = MSO(p);
+}
+
+static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp)
+{
+ struct erl_off_heap_header* oh = MSO(hcp->p).first;
+
+ if (oh != hcp->off_heap.first) {
+ ASSERT(oh != NULL);
+ if (hcp->off_heap.first) {
+ while (oh->next != hcp->off_heap.first) {
+ oh = oh->next;
+ }
+ oh->next = NULL;
+ }
+ erts_cleanup_offheap(&MSO(hcp->p));
+ MSO(hcp->p) = hcp->off_heap;
+ }
+ if (MBUF(hcp->p) != hcp->mbuf) {
+ ErlHeapFragment* hf = MBUF(hcp->p);
+ ASSERT(hf != NULL);
+ if (hcp->mbuf) {
+ while (hf->next != hcp->mbuf) {
+ hf = hf->next;
+ }
+ hf->next = NULL;
+ }
+ free_message_buffer(MBUF(hcp->p));
+ MBUF(hcp->p) = hcp->mbuf;
+ }
+ if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) {
+ hcp->mbuf->used_size = hcp->used_size;
+ }
+ HEAP_TOP(hcp->p) = hcp->htop;
+}
+#endif /* HALFWORD_HEAP */
+
+static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base)
+{
+ if (!is_immed(term)) {
+ Uint sz = size_object_rel(term, base);
+ Eterm* top = HAllocX(p, sz, HEAP_XTRA);
+ return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL);
+ }
+ return term;
+}
+
+
/*
** Execution of the match program, this is Pam.
** May return THE_NON_VALUE, which is a bailout.
-** the para meter 'arity' is only used if 'term' is actually an array,
+** the parameter 'arity' is only used if 'term' is actually an array,
** i.e. 'DCOMP_TRACE' was specified
*/
-Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
+Eterm db_prog_match(Process *c_p, Binary *bprog,
+ Eterm term, Eterm* base,
Eterm *termp,
int arity,
+ enum erts_pam_run_flags in_flags,
Uint32 *return_flags)
{
MatchProg *prog = Binary2MatchProg(bprog);
@@ -1623,7 +1688,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
Eterm t;
Eterm **sp;
Eterm *esp;
- Eterm *hp;
+ MatchVariable* variables;
BeamInstr *cp;
UWord *pc = prog->text;
Eterm *ehp;
@@ -1633,19 +1698,24 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
unsigned do_catch;
ErtsMatchPseudoProcess *mpsp;
Process *psp;
+ Process* build_proc;
Process *tmpp;
Process *current_scheduled;
ErtsSchedulerData *esdp;
Eterm (*bif)(Process*, ...);
int fail_label;
int atomic_trace;
+#if HALFWORD_HEAP
+ struct heap_checkpoint_t c_p_checkpoint = {};
+#endif
#ifdef DMC_DEBUG
Uint *heap_fence;
- Uint *eheap_fence;
Uint *stack_fence;
Uint save_op;
#endif /* DMC_DEBUG */
+ ASSERT(base==NULL || HALFWORD_HEAP);
+
mpsp = get_match_pseudo_process(c_p, prog->heap_size);
psp = &mpsp->process;
@@ -1655,7 +1725,6 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p);
ASSERT(esdp != NULL);
current_scheduled = esdp->current_process;
- esdp->current_process = psp;
/* SMP: psp->scheduler_data is set by get_match_pseudo_process */
atomic_trace = 0;
@@ -1678,11 +1747,9 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
#ifdef DMC_DEBUG
save_op = 0;
- heap_fence = (Uint *) mpsp->heap + prog->eheap_offset - 1;
- eheap_fence = (Uint *) mpsp->heap + prog->stack_offset - 1;
- stack_fence = (Uint *) mpsp->heap + prog->heap_size - 1;
+ heap_fence = (Eterm*)((char*) mpsp->u.heap + prog->stack_offset) - 1;
+ stack_fence = (Eterm*)((char*) mpsp->u.heap + prog->heap_size) - 1;
*heap_fence = FENCE_PATTERN;
- *eheap_fence = FENCE_PATTERN;
*stack_fence = FENCE_PATTERN;
#endif /* DMC_DEBUG */
@@ -1696,36 +1763,48 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term,
*return_flags = 0U;
+ variables = mpsp->u.variables;
+#if HALFWORD_HEAP
+ c_p_checkpoint.p = NULL;
+#endif
+
restart:
ep = &term;
- esp = mpsp->heap + prog->stack_offset;
+ esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset);
sp = (Eterm **) esp;
- hp = mpsp->heap;
- ehp = mpsp->heap + prog->eheap_offset;
ret = am_true;
do_catch = 0;
fail_label = -1;
+ build_proc = psp;
+ esdp->current_process = psp;
+ ASSERT_HALFWORD(!c_p_checkpoint.p);
+
+#ifdef DEBUG
+ ASSERT(variables == mpsp->u.variables);
+ for (i=0; i<prog->num_bindings; i++) {
+ variables[i].term = THE_NON_VALUE;
+ variables[i].proc = NULL;
+ variables[i].base = base;
+ }
+#endif
for (;;) {
-#ifdef DMC_DEBUG
+
+ #ifdef DMC_DEBUG
if (*heap_fence != FENCE_PATTERN) {
erl_exit(1, "Heap fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
}
- if (*eheap_fence != FENCE_PATTERN) {
- erl_exit(1, "Eheap fence overwritten in db_prog_match after op "
- "0x%08x, overwritten with 0x%08x.", save_op,
- *eheap_fence);
- }
if (*stack_fence != FENCE_PATTERN) {
erl_exit(1, "Stack fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op,
*stack_fence);
}
save_op = *pc;
-#endif
+ #endif
switch (*pc++) {
case matchTryMeElse:
+ ASSERT(fail_label == -1);
fail_label = *pc++;
break;
case matchArray: /* only when DCOMP_TRACE, is always first
@@ -1736,13 +1815,14 @@ restart:
ep = termp;
break;
case matchArrayBind: /* When the array size is unknown. */
+ ASSERT(termp);
n = *pc++;
- hp[n] = dpm_array_to_list(psp, termp, arity);
+ variables[n].term = dpm_array_to_list(psp, termp, arity);
break;
case matchTuple: /* *ep is a tuple of arity n */
- if (!is_tuple(*ep))
+ if (!is_tuple_rel(*ep,base))
FAIL();
- ep = tuple_val(*ep);
+ ep = tuple_val_rel(*ep,base);
n = *pc++;
if (arityval(*ep) != n)
FAIL();
@@ -1750,9 +1830,9 @@ restart:
break;
case matchPushT: /* *ep is a tuple of arity n,
push ptr to first element */
- if (!is_tuple(*ep))
+ if (!is_tuple_rel(*ep,base))
FAIL();
- tp = tuple_val(*ep);
+ tp = tuple_val_rel(*ep,base);
n = *pc++;
if (arityval(*tp) != n)
FAIL();
@@ -1762,12 +1842,12 @@ restart:
case matchList:
if (!is_list(*ep))
FAIL();
- ep = list_val(*ep);
+ ep = list_val_rel(*ep,base);
break;
case matchPushL:
if (!is_list(*ep))
FAIL();
- *sp++ = list_val(*ep);
+ *sp++ = list_val_rel(*ep,base);
++ep;
break;
case matchPop:
@@ -1775,41 +1855,44 @@ restart:
break;
case matchBind:
n = *pc++;
- hp[n] = *ep++;
+ variables[n].term = *ep++;
break;
case matchCmp:
n = *pc++;
- if (!eq(hp[n],*ep))
+ if (!eq_rel(variables[n].term, base, *ep, base))
FAIL();
++ep;
break;
case matchEqBin:
t = (Eterm) *pc++;
- if (!eq(*ep,t))
+ if (!eq_rel(t,NULL,*ep,base))
FAIL();
++ep;
break;
case matchEqFloat:
- if (!is_float(*ep))
+ if (!is_float_rel(*ep,base))
FAIL();
- if (memcmp(float_val(*ep) + 1, pc, sizeof(double)))
+ if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double)))
FAIL();
pc += TermWords(2);
++ep;
break;
- case matchEqRef:
- if (!is_ref(*ep))
+ case matchEqRef: {
+ Eterm* epc = (Eterm*)pc;
+ if (!is_ref_rel(*ep,base))
FAIL();
- if (!eq(*ep, make_internal_ref((Uint *) pc)))
+ if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) {
FAIL();
- i = thing_arityval(*((Uint *) pc));
+ }
+ i = thing_arityval(*epc);
pc += TermWords(i+1);
++ep;
break;
+ }
case matchEqBig:
- if (!is_big(*ep))
+ if (!is_big_rel(*ep,base))
FAIL();
- tp = big_val(*ep);
+ tp = big_val_rel(*ep,base);
{
Eterm *epc = (Eterm *) pc;
if (*tp != *epc)
@@ -1825,7 +1908,8 @@ restart:
++ep;
break;
case matchEq:
- t = (Eterm) *pc++;
+ t = (Eterm) *pc++;
+ ASSERT(is_immed(t));
if (t != *ep++)
FAIL();
break;
@@ -1833,25 +1917,32 @@ restart:
++ep;
break;
/*
- * Here comes guard instructions
+ * Here comes guard & body instructions
*/
case matchPushC: /* Push constant */
- *esp++ = *pc++;
+ if ((in_flags & ERTS_PAM_COPY_RESULT)
+ && do_catch && !is_immed(*pc)) {
+ *esp++ = copy_object(*pc++, c_p);
+ }
+ else {
+ *esp++ = *pc++;
+ }
break;
case matchConsA:
- ehp[1] = *--esp;
- ehp[0] = esp[-1];
+ ehp = HAllocX(build_proc, 2, HEAP_XTRA);
+ CDR(ehp) = *--esp;
+ CAR(ehp) = esp[-1];
esp[-1] = make_list(ehp);
- ehp += 2;
break;
case matchConsB:
- ehp[0] = *--esp;
- ehp[1] = esp[-1];
+ ehp = HAllocX(build_proc, 2, HEAP_XTRA);
+ CAR(ehp) = *--esp;
+ CDR(ehp) = esp[-1];
esp[-1] = make_list(ehp);
- ehp += 2;
break;
case matchMkTuple:
n = *pc++;
+ ehp = HAllocX(build_proc, n+1, HEAP_XTRA);
t = make_tuple(ehp);
*ehp++ = make_arityval(n);
while (n--) {
@@ -1861,7 +1952,7 @@ restart:
break;
case matchCall0:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(psp);
+ t = (*bif)(build_proc);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1872,7 +1963,7 @@ restart:
break;
case matchCall1:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(psp, esp[-1]);
+ t = (*bif)(build_proc, esp[-1]);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1883,7 +1974,7 @@ restart:
break;
case matchCall2:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(psp, esp[-1], esp[-2]);
+ t = (*bif)(build_proc, esp[-1], esp[-2]);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1895,7 +1986,7 @@ restart:
break;
case matchCall3:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(psp, esp[-1], esp[-2], esp[-3]);
+ t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1905,15 +1996,73 @@ restart:
esp -= 2;
esp[-1] = t;
break;
+
+ #if HALFWORD_HEAP
+ case matchPushVGuard:
+ if (!base) goto case_matchPushV;
+ /* Build NULL-based copy on pseudo heap for easy disposal */
+ n = *pc++;
+ ASSERT(is_value(variables[n].term));
+ ASSERT(!variables[n].proc);
+ variables[n].term = copy_object_rel(psp, variables[n].term, base);
+ *esp++ = variables[n].term;
+ #ifdef DEBUG
+ variables[n].proc = psp;
+ variables[n].base = NULL;
+ #endif
+ break;
+ #endif
+ case matchPushVResult:
+ if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV;
+
+ /* Build (NULL-based) copy on callers heap */
+ #if HALFWORD_HEAP
+ if (!do_catch && !c_p_checkpoint.p) {
+ heap_checkpoint_init(c_p, &c_p_checkpoint);
+ }
+ #endif
+ n = *pc++;
+ ASSERT(is_value(variables[n].term));
+ ASSERT(!variables[n].proc);
+ variables[n].term = copy_object_rel(c_p, variables[n].term, base);
+ *esp++ = variables[n].term;
+ #ifdef DEBUG
+ variables[n].proc = c_p;
+ variables[n].base = NULL;
+ #endif
+ break;
case matchPushV:
- *esp++ = hp[*pc++];
+ case_matchPushV:
+ n = *pc++;
+ ASSERT(is_value(variables[n].term));
+ ASSERT(!variables[n].base);
+ *esp++ = variables[n].term;
break;
case matchPushExpr:
- *esp++ = term;
+ if (in_flags & ERTS_PAM_COPY_RESULT) {
+ Uint sz;
+ Eterm* top;
+ sz = size_object_rel(term, base);
+ top = HAllocX(build_proc, sz, HEAP_XTRA);
+ if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) {
+ ASSERT(is_tuple_rel(term,base));
+ *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz,
+ &top, &MSO(build_proc), base);
+ }
+ else {
+ *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc),
+ base, NULL);
+ }
+ }
+ else {
+ *esp = term;
+ }
break;
case matchPushArrayAsList:
+ ASSERT_HALFWORD(base == NULL);
n = arity; /* Only happens when 'term' is an array */
tp = termp;
+ ehp = HAllocX(build_proc, n*2, HEAP_XTRA);
*esp++ = make_list(ehp);
while (n--) {
*ehp++ = *tp++;
@@ -1926,7 +2075,8 @@ restart:
break;
case matchPushArrayAsListU:
/* This instruction is NOT efficient. */
- *esp++ = dpm_array_to_list(psp, termp, arity);
+ ASSERT_HALFWORD(base == NULL);
+ *esp++ = dpm_array_to_list(build_proc, termp, arity);
break;
case matchTrue:
if (*--esp != am_true)
@@ -2012,7 +2162,7 @@ restart:
case matchProcessDump: {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p);
- *esp++ = new_binary(psp, (byte *)dsbufp->str, (int)dsbufp->str_len);
+ *esp++ = new_binary(build_proc, (byte *)dsbufp->str, (int)dsbufp->str_len);
erts_destroy_tmp_dsbuf(dsbufp);
break;
}
@@ -2056,29 +2206,24 @@ restart:
if (SEQ_TRACE_TOKEN(c_p) == NIL)
*esp++ = NIL;
else {
+ Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
+ Uint sender_sz = is_immed(sender) ? 0 : size_object(sender);
+ ehp = HAllocX(build_proc, 6 + sender_sz, HEAP_XTRA);
+ if (sender_sz) {
+ sender = copy_struct(sender, sender_sz, &ehp, &MSO(build_proc));
+ }
*esp++ = make_tuple(ehp);
ehp[0] = make_arityval(5);
ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p);
ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p);
ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p);
- ehp[4] = SEQ_TRACE_TOKEN_SENDER(c_p);
+ ehp[4] = sender;
ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p);
ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
ASSERT(is_immed(ehp[1]));
ASSERT(is_immed(ehp[2]));
ASSERT(is_immed(ehp[3]));
ASSERT(is_immed(ehp[5]));
- if(!is_immed(ehp[4])) {
- Eterm *sender = &ehp[4];
- ehp += 6;
- *sender = copy_struct(*sender,
- size_object(*sender),
- &ehp,
- &MSO(psp));
- }
- else
- ehp += 6;
-
}
break;
case matchEnableTrace:
@@ -2127,12 +2272,12 @@ restart:
if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) {
*esp++ = am_undefined;
} else {
+ ehp = HAllocX(build_proc, 4, HEAP_XTRA);
*esp++ = make_tuple(ehp);
ehp[0] = make_arityval(3);
ehp[1] = cp[0];
ehp[2] = cp[1];
ehp[3] = make_small((Uint) cp[2]);
- ehp += 4;
}
break;
case matchSilent:
@@ -2209,8 +2354,12 @@ restart:
}
}
break;
- case matchCatch:
+ case matchCatch: /* Match success, now build result */
do_catch = 1;
+ if (in_flags & ERTS_PAM_COPY_RESULT) {
+ build_proc = c_p;
+ esdp->current_process = c_p;
+ }
break;
case matchHalt:
goto success;
@@ -2219,9 +2368,16 @@ restart:
}
}
fail:
+#if HALFWORD_HEAP
+ if (c_p_checkpoint.p) {
+ /* Dispose garbage built by guards on caller heap */
+ heap_checkpoint_revert(&c_p_checkpoint);
+ c_p_checkpoint.p = NULL;
+ }
+#endif
*return_flags = 0U;
- if (fail_label >= 0) { /* We failed during a "TryMeElse",
- lets restart, with the next match
+ if (fail_label >= 0) { /* We failed during a "TryMeElse",
+ lets restart, with the next match
program */
pc = (prog->text) + fail_label;
cleanup_match_pseudo_process(mpsp, 1);
@@ -2235,11 +2391,6 @@ success:
erl_exit(1, "Heap fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
}
- if (*eheap_fence != FENCE_PATTERN) {
- erl_exit(1, "Eheap fence overwritten in db_prog_match after op "
- "0x%08x, overwritten with 0x%08x.", save_op,
- *eheap_fence);
- }
if (*stack_fence != FENCE_PATTERN) {
erl_exit(1, "Stack fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op,
@@ -2250,6 +2401,7 @@ success:
esdp->current_process = current_scheduled;
END_ATOMIC_TRACE(c_p);
+
return ret;
#undef FAIL
#undef FAIL_TERM
@@ -2261,7 +2413,8 @@ success:
/*
* Convert a match program to a "magic" binary to return up to erlang
*/
-Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) {
+Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp)
+{
return erts_mk_magic_binary_term(hpp, &MSO(p), mp);
}
@@ -2327,13 +2480,13 @@ void db_free_dmc_err_info(DMCErrInfo *ei){
** Store bignum in *hpp and increase *hpp accordingly.
** *hpp is assumed to be large enough to hold the result.
*/
-Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr)
+Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr)
{
DeclareTmpHeapNoproc(big_tmp,2);
Eterm res;
Sint ires;
- Eterm arg1;
- Eterm arg2;
+ Wterm arg1;
+ Wterm arg2;
if (is_both_small(counter,incr)) {
ires = signed_val(counter) + signed_val(incr);
@@ -2374,6 +2527,34 @@ Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr)
}
}
+/* Must be called to read elements after db_lookup_dbterm.
+** Will decompress if needed.
+** HEALFWORD_HEAP:
+** Will convert from relative to Wterm format if needed.
+** (but only on top level, tuples and lists will still contain rterms)
+*/
+Wterm db_do_read_element(DbUpdateHandle* handle, Sint position)
+{
+ Eterm elem = handle->dbterm->tpl[position];
+ if (!is_header(elem)) {
+#if HALFWORD_HEAP
+ if (!is_immed(elem)
+ && !handle->tb->common.compress
+ && !(handle->abs_vec && handle->abs_vec[position])) {
+ return rterm2wterm(elem, handle->dbterm->tpl);
+ }
+#endif
+ return elem;
+ }
+
+ ASSERT(((DbTableCommon*)handle->tb)->compress);
+ ASSERT(!handle->mustResize);
+ handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common,
+ handle->dbterm);
+ handle->mustResize = 1;
+ return handle->dbterm->tpl[position];
+}
+
/*
** Update one element:
** handle: Initialized by db_lookup_dbterm()
@@ -2390,14 +2571,17 @@ void db_do_update_element(DbUpdateHandle* handle,
Eterm* oldp;
Uint newval_sz;
Uint oldval_sz;
+#if HALFWORD_HEAP
+ Eterm* old_base;
+#endif
if (is_both_immed(newval,oldval)) {
handle->dbterm->tpl[position] = newval;
-#ifdef DEBUG_CLONE
+ #ifdef DEBUG_CLONE
if (handle->dbterm->debug_clone) {
handle->dbterm->debug_clone[position] = newval;
}
-#endif
+ #endif
return;
}
if (!handle->mustResize) {
@@ -2406,49 +2590,78 @@ void db_do_update_element(DbUpdateHandle* handle,
handle->dbterm);
handle->mustResize = 1;
oldval = handle->dbterm->tpl[position];
+ #if HALFWORD_HEAP
+ old_base = NULL;
+ #endif
}
- else if (is_boxed(newval)) {
- newp = boxed_val(newval);
- switch (*newp & _TAG_HEADER_MASK) {
- case _TAG_HEADER_POS_BIG:
- case _TAG_HEADER_NEG_BIG:
- case _TAG_HEADER_FLOAT:
- case _TAG_HEADER_HEAP_BIN:
- newval_sz = header_arity(*newp) + 1;
- if (is_boxed(oldval)) {
- oldp = boxed_val(oldval);
- switch (*oldp & _TAG_HEADER_MASK) {
- case _TAG_HEADER_POS_BIG:
- case _TAG_HEADER_NEG_BIG:
- case _TAG_HEADER_FLOAT:
- case _TAG_HEADER_HEAP_BIN:
- oldval_sz = header_arity(*oldp) + 1;
- if (oldval_sz == newval_sz) {
- /* "self contained" terms of same size, do memcpy */
- sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm));
- return;
+ else {
+ #if HALFWORD_HEAP
+ ASSERT(!handle->abs_vec);
+ old_base = handle->dbterm->tpl;
+ #endif
+ if (is_boxed(newval)) {
+ newp = boxed_val(newval);
+ switch (*newp & _TAG_HEADER_MASK) {
+ case _TAG_HEADER_POS_BIG:
+ case _TAG_HEADER_NEG_BIG:
+ case _TAG_HEADER_FLOAT:
+ case _TAG_HEADER_HEAP_BIN:
+ newval_sz = header_arity(*newp) + 1;
+ if (is_boxed(oldval)) {
+ oldp = boxed_val_rel(oldval,old_base);
+ switch (*oldp & _TAG_HEADER_MASK) {
+ case _TAG_HEADER_POS_BIG:
+ case _TAG_HEADER_NEG_BIG:
+ case _TAG_HEADER_FLOAT:
+ case _TAG_HEADER_HEAP_BIN:
+ oldval_sz = header_arity(*oldp) + 1;
+ if (oldval_sz == newval_sz) {
+ /* "self contained" terms of same size, do memcpy */
+ sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm));
+ return;
+ }
+ goto both_size_set;
}
- goto both_size_set;
}
+ goto new_size_set;
}
- goto new_size_set;
}
}
}
+#if HALFWORD_HEAP
+ else {
+ old_base = (handle->tb->common.compress
+ || (handle->abs_vec && handle->abs_vec[position])) ?
+ NULL : handle->dbterm->tpl;
+ }
+#endif
/* Not possible for simple memcpy or dbterm is already non-contiguous, */
/* need to realloc... */
newval_sz = is_immed(newval) ? 0 : size_object(newval);
new_size_set:
-
- oldval_sz = is_immed(oldval) ? 0 : size_object(oldval);
+
+ oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base);
both_size_set:
handle->new_size = handle->new_size - oldval_sz + newval_sz;
- /* write new value in old dbterm, finalize will make a flat copy */
+ /* write new value in old dbterm, finalize will make a flat copy */
handle->dbterm->tpl[position] = newval;
handle->mustResize = 1;
+
+#if HALFWORD_HEAP
+ if (old_base && newval_sz > 0) {
+ ASSERT(!handle->tb->common.compress);
+ if (!handle->abs_vec) {
+ int i = header_arity(handle->dbterm->tpl[0]);
+ handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char));
+ sys_memset(handle->abs_vec, 0, i+1);
+ /* abs_vec[0] not used */
+ }
+ handle->abs_vec[position] = 1;
+ }
+#endif
}
static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old,
@@ -2547,7 +2760,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
tpl[arity + 1] = alloc_size;
tmp_offheap.first = NULL;
- tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap);
+ tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl);
dest->first_oh = tmp_offheap.first;
for (i=1; i<=arity; i++) {
if (i != tb->keypos) {
@@ -2566,7 +2779,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm));
dest->debug_clone = dbg_top;
tmp_offheap.first = dest->first_oh;
- copy_struct(obj, dest->size, &dbg_top, &tmp_offheap);
+ copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top);
dest->first_oh = tmp_offheap.first;
ASSERT(dbg_top == dest->debug_clone + dest->size);
}
@@ -2613,7 +2826,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
newp->size = size;
top = newp->tpl;
tmp_offheap.first = NULL;
- copy_struct(obj, size, &top, &tmp_offheap);
+ copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top);
newp->first_oh = tmp_offheap.first;
#ifdef DEBUG_CLONE
newp->debug_clone = NULL;
@@ -2652,7 +2865,7 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
top = copy_to_comp(tb, obj, newp, new_sz);
ASSERT(top <= basep + new_sz);
- // SVERK: realloc?
+ /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */
return basep;
}
@@ -2673,6 +2886,9 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset)
*(handle->bp) = newp;
newDbTerm = (DbTerm*) (newp + offset);
newDbTerm->size = handle->new_size;
+#ifdef DEBUG_CLONE
+ newDbTerm->debug_clone = NULL;
+#endif
/* make a flat copy */
@@ -2682,17 +2898,38 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset)
db_free_tmp_uncompressed(handle->dbterm);
}
else {
- Eterm* top;
ErlOffHeap tmp_offheap;
+ Eterm* tpl = handle->dbterm->tpl;
+ Eterm* top = newDbTerm->tpl;
+
tmp_offheap.first = NULL;
- top = newDbTerm->tpl;
- copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size,
- &top, &tmp_offheap);
- newDbTerm->first_oh = tmp_offheap.first;
-#ifdef DEBUG_CLONE
- newDbTerm->debug_clone = NULL;
-#endif
- ASSERT((byte*)top <= (newp + alloc_sz));
+
+ #if HALFWORD_HEAP
+ if (handle->abs_vec) {
+ int i, arity = header_arity(handle->dbterm->tpl[0]);
+
+ top[0] = tpl[0];
+ top += arity + 1;
+ for (i=1; i<=arity; i++) {
+ Eterm* src_base = handle->abs_vec[i] ? NULL : tpl;
+
+ newDbTerm->tpl[i] = copy_struct_rel(tpl[i],
+ size_object_rel(tpl[i],src_base),
+ &top, &tmp_offheap, src_base,
+ newDbTerm->tpl);
+ }
+ newDbTerm->first_oh = tmp_offheap.first;
+ ASSERT((byte*)top <= (newp + alloc_sz));
+ erts_free(ERTS_ALC_T_TMP, handle->abs_vec);
+ }
+ else
+ #endif /* HALFWORD_HEAP */
+ {
+ copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top,
+ &tmp_offheap, tpl, top);
+ newDbTerm->first_oh = tmp_offheap.first;
+ ASSERT((byte*)top == (newp + alloc_sz));
+ }
}
}
@@ -2705,9 +2942,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
hp[0] = bp->tpl[0];
*hpp += arity + 1;
- hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos],
- size_object(bp->tpl[tb->keypos]),
- hpp, off_heap);
+ hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos],
+ size_object_rel(bp->tpl[tb->keypos], bp->tpl),
+ hpp, off_heap, bp->tpl, NULL);
for (i=arity; i>0; i--) {
if (i != tb->keypos) {
if (is_immed(bp->tpl[i])) {
@@ -2721,7 +2958,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
}
ASSERT((*hpp - hp) <= bp->size);
#ifdef DEBUG_CLONE
- ASSERT(eq(make_tuple(hp),make_tuple(bp->debug_clone)));
+ ASSERT(eq_rel(make_tuple(hp),make_tuple(bp->debug_clone),bp->debug_clone));
#endif
return make_tuple(hp);
}
@@ -2744,14 +2981,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p,
hp += extra;
HRelease(p, endp, hp);
#ifdef DEBUG_CLONE
- ASSERT(eq(copy,obj->debug_clone[pos]));
+ ASSERT(eq_rel(copy, obj->debug_clone[pos], obj->debug_clone));
#endif
return copy;
}
else {
- Uint sz = size_object(obj->tpl[pos]);
+ Uint sz = size_object_rel(obj->tpl[pos], obj->tpl);
*hpp = HAlloc(p, sz + extra);
- return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p));
+ return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL);
}
}
@@ -2765,7 +3002,7 @@ void db_cleanup_offheap_comp(DbTerm* obj)
ProcBin tmp;
for (u.hdr = obj->first_oh; u.hdr; u.hdr = u.hdr->next) {
- if ((UWord)u.voidp % sizeof(UWord) != 0) { /* unaligned ptr */
+ if ((UWord)u.voidp % sizeof(Uint) != 0) { /* unaligned ptr */
sys_memcpy(&tmp, u.voidp, sizeof(tmp));
/* Warning, must pass (void*)-variable to memcpy. Otherwise it will
cause Bus error on Sparc due to false compile time assumptions
@@ -2961,7 +3198,7 @@ static DMCRet dmc_one_term(DMCContext *context,
** Ouch, big integer in match variable.
*/
Eterm *save_hp;
- ASSERT(heap->data == heap->def);
+ ASSERT(heap->vars == heap->vars_def);
sz = sz2 = sz3 = 0;
for (j = 0; j < context->num_match; ++j) {
sz += size_object(context->matchexpr[j]);
@@ -2999,24 +3236,23 @@ static DMCRet dmc_one_term(DMCContext *context,
may be atoms that changed */
context->matchexpr[j] = context->copy->mem[j];
}
- heap->data = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP,
- heap->size*sizeof(unsigned));
- sys_memset(heap->data, 0,
- heap->size * sizeof(unsigned));
+ heap->vars = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP,
+ heap->size*sizeof(DMCVariable));
+ sys_memset(heap->vars, 0, heap->size * sizeof(DMCVariable));
DMC_CLEAR(*stack);
/*DMC_PUSH(*stack,NIL);*/
DMC_CLEAR(*text);
return retRestart;
}
- if (heap->data[n]) { /* already bound ? */
+ if (heap->vars[n].is_bound) {
DMC_PUSH(*text,matchCmp);
DMC_PUSH(*text,n);
} else { /* Not bound, bind! */
- if (n >= heap->used)
- heap->used = n + 1;
+ if (n >= heap->vars_used)
+ heap->vars_used = n + 1;
DMC_PUSH(*text,matchBind);
DMC_PUSH(*text,n);
- heap->data[n] = 1;
+ heap->vars[n].is_bound = 1;
}
} else if (c == am_Underscore) {
DMC_PUSH(*text, matchSkip);
@@ -3041,6 +3277,8 @@ static DMCRet dmc_one_term(DMCContext *context,
DMC_PUSH(*stack, c);
break;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
+ {
+ Eterm* ref_val = internal_ref_val(c);
DMC_PUSH(*text, matchEqRef);
#if HALFWORD_HEAP
{
@@ -3048,25 +3286,27 @@ static DMCRet dmc_one_term(DMCContext *context,
UWord u;
Uint t[2];
} fiddle;
- ASSERT(thing_arityval(*internal_ref_val(c)) == 3);
- fiddle.t[0] = *internal_ref_val(c);
- fiddle.t[1] = (Uint) internal_ref_val(c)[1];
+ ASSERT(thing_arityval(ref_val[0]) == 3);
+ fiddle.t[0] = ref_val[0];
+ fiddle.t[1] = ref_val[1];
DMC_PUSH(*text, fiddle.u);
- fiddle.t[0] = (Uint) internal_ref_val(c)[2];
- fiddle.t[1] = (Uint) internal_ref_val(c)[3];
+ fiddle.t[0] = ref_val[2];
+ fiddle.t[1] = ref_val[3];
DMC_PUSH(*text, fiddle.u);
}
#else
- n = thing_arityval(*internal_ref_val(c));
- DMC_PUSH(*text, *internal_ref_val(c));
- for (i = 1; i <= n; ++i) {
- DMC_PUSH(*text, (Uint) internal_ref_val(c)[i]);
+ n = thing_arityval(ref_val[0]);
+ for (i = 0; i <= n; ++i) {
+ DMC_PUSH(*text, ref_val[i]);
}
#endif
break;
+ }
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- n = thing_arityval(*big_val(c));
+ {
+ Eterm* bval = big_val(c);
+ n = thing_arityval(bval[0]);
DMC_PUSH(*text, matchEqBig);
#if HALFWORD_HEAP
{
@@ -3075,13 +3315,13 @@ static DMCRet dmc_one_term(DMCContext *context,
Uint t[2];
} fiddle;
ASSERT(n >= 1);
- fiddle.t[0] = *big_val(c);
- fiddle.t[1] = big_val(c)[1];
+ fiddle.t[0] = bval[0];
+ fiddle.t[1] = bval[1];
DMC_PUSH(*text, fiddle.u);
for (i = 2; i <= n; ++i) {
- fiddle.t[0] = big_val(c)[i];
+ fiddle.t[0] = bval[i];
if (++i <= n) {
- fiddle.t[1] = big_val(c)[i];
+ fiddle.t[1] = bval[i];
} else {
fiddle.t[1] = (Uint) 0;
}
@@ -3089,12 +3329,12 @@ static DMCRet dmc_one_term(DMCContext *context,
}
}
#else
- DMC_PUSH(*text, *big_val(c));
- for (i = 1; i <= n; ++i) {
- DMC_PUSH(*text, (Uint) big_val(c)[i]);
+ for (i = 0; i <= n; ++i) {
+ DMC_PUSH(*text, (Uint) bval[i]);
}
#endif
break;
+ }
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
DMC_PUSH(*text,matchEqFloat);
#if HALFWORD_HEAP
@@ -3227,7 +3467,6 @@ static DMCRet dmc_list(DMCContext *context,
DMC_PUSH(*text, matchConsB);
}
--context->stack_used; /* Two objects on stack becomes one */
- context->eheap_need += 2;
return retOk;
}
@@ -3286,7 +3525,6 @@ static DMCRet dmc_tuple(DMCContext *context,
DMC_PUSH(*text, matchMkTuple);
DMC_PUSH(*text, nelems);
context->stack_used -= (nelems - 1);
- context->eheap_need += (nelems + 1);
*constant = 0;
return retOk;
}
@@ -3304,9 +3542,6 @@ static DMCRet dmc_whole_expression(DMCContext *context,
} else {
ASSERT(is_tuple(context->matchexpr
[context->current_match]));
- context->eheap_need +=
- arityval(*(tuple_val(context->matchexpr
- [context->current_match]))) * 2;
DMC_PUSH(*text, matchPushArrayAsList);
}
} else {
@@ -3319,6 +3554,41 @@ static DMCRet dmc_whole_expression(DMCContext *context,
return retOk;
}
+/* Figure out which PushV instruction to use.
+*/
+static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap,
+ DMC_STACK_TYPE(UWord) *text, Uint n)
+{
+ DMCVariable* v = &heap->vars[n];
+ MatchOps instr = matchPushV;
+
+ ASSERT(n < heap->vars_used && v->is_bound);
+ if (context->is_guard) {
+ #if HALFWORD_HEAP
+ if (!v->first_guard_label) {
+ v->first_guard_label = DMC_STACK_NUM(*text);
+ ASSERT(v->first_guard_label);
+ instr = matchPushVGuard; /* may be changed to PushVResult below */
+ }
+ #endif
+ }
+ else { /* body */
+ #if HALFWORD_HEAP
+ if (v->first_guard_label) {
+ /* Avoid double-copy, copy to result heap at first encounter in guard */
+ DMC_POKE(*text, v->first_guard_label, matchPushVResult);
+ v->is_in_body = 1;
+ }
+ #endif
+ if (!v->is_in_body) {
+ instr = matchPushVResult;
+ v->is_in_body = 1;
+ }
+ }
+ DMC_PUSH(*text, instr);
+ DMC_PUSH(*text, n);
+}
+
static DMCRet dmc_variable(DMCContext *context,
DMCHeap *heap,
DMC_STACK_TYPE(UWord) *text,
@@ -3326,13 +3596,13 @@ static DMCRet dmc_variable(DMCContext *context,
int *constant)
{
Uint n = db_is_variable(t);
- ASSERT(n >= 0);
- if (n >= heap->used)
- RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant);
- if (heap->data[n] == 0U)
+
+ if (n >= heap->vars_used || !heap->vars[n].is_bound) {
RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant);
- DMC_PUSH(*text, matchPushV);
- DMC_PUSH(*text, n);
+ }
+
+ dmc_add_pushv_variant(context, heap, text, n);
+
++context->stack_used;
if (context->stack_used > context->stack_need)
context->stack_need = context->stack_used;
@@ -3351,10 +3621,9 @@ static DMCRet dmc_all_bindings(DMCContext *context,
DMC_PUSH(*text, matchPushC);
DMC_PUSH(*text, NIL);
- for (i = heap->used - 1; i >= 0; --i) {
- if (heap->data[i]) {
- DMC_PUSH(*text, matchPushV);
- DMC_PUSH(*text, i);
+ for (i = heap->vars_used - 1; i >= 0; --i) {
+ if (heap->vars[i].is_bound) {
+ dmc_add_pushv_variant(context, heap, text, i);
DMC_PUSH(*text, matchConsB);
heap_used += 2;
}
@@ -3362,7 +3631,6 @@ static DMCRet dmc_all_bindings(DMCContext *context,
++context->stack_used;
if ((context->stack_used + 1) > context->stack_need)
context->stack_need = (context->stack_used + 1);
- context->eheap_need += heap_used;
*constant = 0;
return retOk;
}
@@ -3765,10 +4033,6 @@ static DMCRet dmc_get_seq_token(DMCContext *context,
*constant = 0;
DMC_PUSH(*text, matchGetSeqToken);
- context->eheap_need += (6 /* A 5-tuple is built */
- + EXTERNAL_THING_HEAD_SIZE + 2 /* Sender can
- be an external
- pid */);
if (++context->stack_used > context->stack_need)
context->stack_need = context->stack_used;
return retOk;
@@ -4065,7 +4329,6 @@ static DMCRet dmc_caller(DMCContext *context,
}
*constant = 0;
DMC_PUSH(*text, matchCaller); /* Creates binary */
- context->eheap_need += 4; /* A 3-tuple is built */
if (++context->stack_used > context->stack_need)
context->stack_need = context->stack_used;
return retOk;
@@ -4663,7 +4926,8 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
}
save_cp = p->cp;
p->cp = NULL;
- res = erts_match_set_run(p, mps, arr, n, &ret_flags);
+ res = erts_match_set_run(p, mps, arr, n,
+ ERTS_PAM_COPY_RESULT, &ret_flags);
p->cp = save_cp;
} else {
n = 0;
@@ -4676,11 +4940,10 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
if (is_non_value(res)) {
res = am_false;
}
- sz = size_object(res);
+ sz = 0;
if (ret_flags & MATCH_SET_EXCEPTION_TRACE) sz += 2;
if (ret_flags & MATCH_SET_RETURN_TRACE) sz += 2;
hp = HAlloc(p, 5 + sz);
- res = copy_struct(res, sz, &hp, &MSO(p));
flg = NIL;
if (ret_flags & MATCH_SET_EXCEPTION_TRACE) {
flg = CONS(hp, am_exception_trace, flg);
@@ -4735,28 +4998,24 @@ void db_free_tmp_uncompressed(DbTerm* obj)
erts_free(ERTS_ALC_T_TMP, obj);
}
-Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog,
+Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra)
{
Uint32 dummy;
+ Eterm* base;
Eterm res;
if (tb->compress) {
obj = db_alloc_tmp_uncompressed(tb, obj);
+ base = NULL;
}
+ else base = HALFWORD_HEAP ? obj->tpl : NULL;
- res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, &dummy);
+ res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0,
+ ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy);
if (is_value(res) && hpp!=NULL) {
- if (all) {
- *hpp = HAlloc(c_p, obj->size + extra);
- res = copy_shallow(obj->tpl, obj->size, hpp, &MSO(c_p));
- }
- else {
- Uint sz = size_object(res);
- *hpp = HAlloc(c_p, sz + extra);
- res = copy_struct(res, sz, hpp, &MSO(c_p));
- }
+ *hpp = HAlloc(c_p, extra);
}
if (tb->compress) {
@@ -4767,10 +5026,11 @@ Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog,
#ifdef DMC_DEBUG
+
/*
** Disassemble match program
*/
-static void db_match_dis(Binary *bp)
+void db_match_dis(Binary *bp)
{
MatchProg *prog = Binary2MatchProg(bp);
UWord *t = prog->text;
@@ -4985,6 +5245,18 @@ static void db_match_dis(Binary *bp)
++t;
erts_printf("PushV\t%bpu\n", n);
break;
+ #if HALFWORD_HEAP
+ case matchPushVGuard:
+ n = (Uint) *++t;
+ ++t;
+ erts_printf("PushVGuard\t%bpu\n", n);
+ break;
+ #endif
+ case matchPushVResult:
+ n = (Uint) *++t;
+ ++t;
+ erts_printf("PushVResult\t%bpu\n", n);
+ break;
case matchTrue:
++t;
erts_printf("True\n");
@@ -5095,7 +5367,6 @@ static void db_match_dis(Binary *bp)
erts_printf("}\n");
erts_printf("num_bindings: %d\n", prog->num_bindings);
erts_printf("heap_size: %bpu\n", prog->heap_size);
- erts_printf("eheap_offset: %bpu\n", prog->eheap_offset);
erts_printf("stack_offset: %bpu\n", prog->stack_offset);
erts_printf("text: 0x%08x\n", (unsigned long) prog->text);
erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset);
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 58ad39d772..bb1751d309 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -86,6 +86,9 @@ typedef struct {
Uint new_size;
int mustResize;
void* lck;
+#if HALFWORD_HEAP
+ unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */
+#endif
} DbUpdateHandle;
@@ -255,7 +258,14 @@ typedef struct db_table_common {
#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0))
#define IS_FIXED(T) (NFIXED(T) != 0)
-Eterm erts_ets_copy_object(Eterm, Process*);
+/*
+ * tplp is an untagged pointer to a tuple we know is large enough
+ * and dth is a pointer to a DbTableHash.
+ */
+#define GETKEY(dth, tplp) (*((tplp) + ((DbTableCommon*)(dth))->keypos))
+
+
+ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj);
Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
ErlOffHeap* off_heap);
int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b);
@@ -264,9 +274,23 @@ DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org);
ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp,
Eterm** hpp, ErlOffHeap* off_heap);
ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b);
-ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position);
+Wterm db_do_read_element(DbUpdateHandle* handle, Sint position);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj)
+{
+ Eterm key = GETKEY(tb, obj->tpl);
+ if IS_CONST(key) return key;
+ else {
+ Uint size = size_object_rel(key, obj->tpl);
+ Eterm* hp = HAlloc(p, size);
+ Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL);
+ ASSERT(eq_rel(res,NULL,key,obj->tpl));
+ return res;
+ }
+}
+
ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp,
Eterm** hpp, ErlOffHeap* off_heap)
{
@@ -274,49 +298,27 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp,
return db_copy_from_comp(tb, bp, hpp, off_heap);
}
else {
- return copy_shallow(bp->tpl, bp->size, hpp, off_heap);
+ return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl);
}
}
ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b)
{
if (!tb->compress) {
- return eq(a, make_tuple(b->tpl));
+ return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl);
}
else {
return db_eq_comp(tb, a, b);
}
}
-/* Must be called to read elements after db_lookup_dbterm.
-** Will decompress if needed. */
-ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position)
-{
- Eterm elem = handle->dbterm->tpl[position];
- if (!is_header(elem)) {
- return elem;
- }
- ASSERT(((DbTableCommon*)handle->tb)->compress);
- ASSERT(!handle->mustResize);
- handle->dbterm = db_alloc_tmp_uncompressed((DbTableCommon*)handle->tb, handle->dbterm);
- handle->mustResize = 1;
- return handle->dbterm->tpl[position];
-}
-
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-/* optimised version of copy_object (normal case? atomic object) */
-#define COPY_OBJECT(obj, p, objp) \
- if (IS_CONST(obj)) { *(objp) = (obj); } \
- else { *objp = erts_ets_copy_object(obj, p); }
#define DB_READ (DB_PROTECTED|DB_PUBLIC)
#define DB_WRITE DB_PUBLIC
#define DB_INFO (DB_PROTECTED|DB_PUBLIC|DB_PRIVATE)
-/* tb is an DbTableCommon and obj is an Eterm (tagged) */
-#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj))
-
#define ONLY_WRITER(P,T) (((T)->common.status & (DB_PRIVATE|DB_PROTECTED)) \
&& (T)->common.owner == (P)->id)
@@ -337,12 +339,11 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj,
Uint pos, Eterm** hpp, Uint extra);
int db_has_variable(Eterm obj);
int db_is_variable(Eterm obj);
-Eterm db_do_read_element(DbUpdateHandle* handle, Sint position);
void db_do_update_element(DbUpdateHandle* handle,
Sint position,
Eterm newval);
void db_finalize_resize(DbUpdateHandle* handle, Uint offset);
-Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr);
+Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr);
Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags);
Binary *db_match_set_compile(Process *p, Eterm matchexpr,
Uint flags);
@@ -359,7 +360,6 @@ typedef struct match_prog {
struct erl_heap_fragment *saved_program_buf;
Eterm saved_program;
Uint heap_size; /* size of: heap + eheap + stack */
- Uint eheap_offset;
Uint stack_offset;
#ifdef DMC_DEBUG
UWord* prog_end; /* End of program */
@@ -423,11 +423,16 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
Eterm *body, int num_matches,
Uint flags,
DMCErrInfo *err_info);
-Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog,
- int all, DbTerm* obj, Eterm** hpp, Uint extra);
/* Returns newly allocated MatchProg binary with refc == 0*/
-Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity,
+
+Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
+ int all, DbTerm* obj, Eterm** hpp, Uint extra);
+
+Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base,
+ Eterm *termp, int arity,
+ enum erts_pam_run_flags in_flags,
Uint32 *return_flags /* Zeroed on enter */);
+
/* returns DB_ERROR_NONE if matches, 1 if not matches and some db error on
error. */
DMCErrInfo *db_new_dmc_err_info(void);
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 0185baee6b..9e18997890 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -155,7 +155,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "alcu_allocator", "index" },
{ "alcu_delayed_free", "index" },
{ "mseg", NULL },
-#ifdef HALFWORD_HEAP
+#if HALFWORD_HEAP
{ "pmmap", NULL },
#endif
#ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index d873c7a701..9751b5d77c 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -85,7 +85,7 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
if (is_ref_thing_header(*b2)) {
return 1;
}
- return cmp(ref1,ref2);
+ return CMP(ref1,ref2);
}
#define CP_LINK_VAL(To, Hp, From) \
@@ -380,7 +380,7 @@ int erts_add_link(ErtsLink **root, Uint type, Eterm pid)
state = 1;
*this = create_link(type,pid);
break;
- } else if ((c = cmp(pid,(*this)->pid)) < 0) {
+ } else if ((c = CMP(pid,(*this)->pid)) < 0) {
/* go left */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
@@ -415,7 +415,7 @@ erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid)
state = 1;
res = *this = create_suspend_monitor(pid);
break;
- } else if ((c = cmp(pid,(*this)->pid)) < 0) {
+ } else if ((c = CMP(pid,(*this)->pid)) < 0) {
/* go left */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
@@ -453,7 +453,7 @@ ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid)
*this = create_link(type,pid);
ret = *this;
break;
- } else if ((c = cmp(pid,(*this)->pid)) < 0) {
+ } else if ((c = CMP(pid,(*this)->pid)) < 0) {
/* go left */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
@@ -663,7 +663,7 @@ ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid)
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp(pid,(*this)->pid)) < 0) {
+ } else if ((c = CMP(pid,(*this)->pid)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -715,7 +715,7 @@ erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid)
for (;;) {
if (!*this) { /* Nothing found */
return;
- } else if ((c = cmp(pid,(*this)->pid)) < 0) {
+ } else if ((c = CMP(pid,(*this)->pid)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -771,7 +771,7 @@ ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid)
Sint c;
for (;;) {
- if (root == NULL || (c = cmp(pid,root->pid)) == 0) {
+ if (root == NULL || (c = CMP(pid,root->pid)) == 0) {
return root;
} else if (c < 0) {
root = root->left;
@@ -787,7 +787,7 @@ erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid)
Sint c;
for (;;) {
- if (root == NULL || (c = cmp(pid,root->pid)) == 0) {
+ if (root == NULL || (c = CMP(pid,root->pid)) == 0) {
return root;
} else if (c < 0) {
root = root->left;
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index a680097c2d..135c6b0ccc 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -81,7 +81,6 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need)
static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp)
{
- unsigned frag_sz;
env->hp = hp;
if (env->heap_frag == NULL) {
ASSERT(HEAP_LIMIT(env->proc) == env->hp_end);
@@ -91,11 +90,11 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp)
env->heap_frag->used_size = hp - env->heap_frag->mem;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
- frag_sz = need + MIN_HEAP_FRAG_SZ;
- hp = erts_heap_alloc(env->proc, frag_sz);
- env->hp = hp + need;
- env->hp_end = hp + frag_sz;
+ hp = erts_heap_alloc(env->proc, need, MIN_HEAP_FRAG_SZ);
env->heap_frag = MBUF(env->proc);
+ env->hp = hp + need;
+ env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size;
+
return hp;
}
@@ -574,7 +573,7 @@ int enif_is_identical(Eterm lhs, Eterm rhs)
int enif_compare(Eterm lhs, Eterm rhs)
{
- return cmp(lhs,rhs);
+ return CMP(lhs,rhs);
}
int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array)
@@ -939,21 +938,26 @@ ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr)
ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...)
{
- Eterm* hp = alloc_heap(env,cnt*2);
- Eterm ret = make_list(hp);
- Eterm* last = &ret;
- va_list ap;
-
- va_start(ap,cnt);
- while (cnt--) {
- *last = make_list(hp);
- *hp = va_arg(ap,Eterm);
- last = ++hp;
- ++hp;
+ if (cnt == 0) {
+ return NIL;
+ }
+ else {
+ Eterm* hp = alloc_heap(env,cnt*2);
+ Eterm ret = make_list(hp);
+ Eterm* last = &ret;
+ va_list ap;
+
+ va_start(ap,cnt);
+ while (cnt--) {
+ *last = make_list(hp);
+ *hp = va_arg(ap,Eterm);
+ last = ++hp;
+ ++hp;
+ }
+ va_end(ap);
+ *last = NIL;
+ return ret;
}
- va_end(ap);
- *last = NIL;
- return ret;
}
ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)
@@ -1474,7 +1478,13 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).",
entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION);
- }
+ }
+ else if (entry->minor >= 1
+ && sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) {
+ ret = load_nif_error(BIF_P, bad_lib, "Library (%s) not compiled for "
+ "this vm variant (%s).",
+ entry->vm_variant, ERL_NIF_VM_VARIANT);
+ }
else if (!erts_is_atom_str((char*)entry->name, mod_atom)) {
ret = load_nif_error(BIF_P, bad_lib, "Library module name '%s' does not"
" match calling module '%T'", entry->name, mod_atom);
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index ee3a7cd5f4..8050b3640a 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -30,9 +30,10 @@
** 0.1: R13B03
** 1.0: R13B04
** 2.0: R14A
+** 2.1: R14B02 "vm_variant"
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 0
+#define ERL_NIF_MINOR_VERSION 1
#include <stdlib.h>
@@ -80,8 +81,10 @@ typedef long long ErlNifSInt64;
#endif
#ifdef HALFWORD_HEAP_EMULATOR
+# define ERL_NIF_VM_VARIANT "beam.halfword"
typedef unsigned int ERL_NIF_TERM;
#else
+# define ERL_NIF_VM_VARIANT "beam.vanilla"
typedef unsigned long ERL_NIF_TERM;
#endif
@@ -105,7 +108,8 @@ typedef struct enif_entry_t
int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
- void (*unload) (ErlNifEnv*, void* priv_data);
+ void (*unload) (ErlNifEnv*, void* priv_data);
+ const char* vm_variant;
}ErlNifEntry;
@@ -198,6 +202,7 @@ extern TWinDynNifCallbacks WinDynNifCallbacks;
#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \
ERL_NIF_INIT_PROLOGUE \
ERL_NIF_INIT_GLOB \
+ERL_NIF_INIT_DECL(NAME); \
ERL_NIF_INIT_DECL(NAME) \
{ \
static ErlNifEntry entry = \
@@ -207,7 +212,8 @@ ERL_NIF_INIT_DECL(NAME) \
#NAME, \
sizeof(FUNCS) / sizeof(*FUNCS), \
FUNCS, \
- LOAD, RELOAD, UPGRADE, UNLOAD \
+ LOAD, RELOAD, UPGRADE, UNLOAD, \
+ ERL_NIF_VM_VARIANT \
}; \
ERL_NIF_INIT_BODY; \
return &entry; \
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index ae1316eba2..2c67e781e0 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -255,19 +255,32 @@ extern int erts_use_r9_pids_ports;
#define internal_ref_no_of_numbers(x) \
(internal_ref_data((x))[0])
+#define internal_thing_ref_no_of_numbers(thing) \
+ (internal_thing_ref_data(thing)[0])
#define internal_ref_numbers(x) \
(&internal_ref_data((x))[1])
+#define internal_thing_ref_numbers(thing) \
+ (&internal_thing_ref_data(thing)[1])
#define external_ref_no_of_numbers(x) \
(external_ref_data((x))[0])
+#define external_thing_ref_no_of_numbers(thing) \
+ (external_thing_ref_data(thing)[0])
#define external_ref_numbers(x) \
(&external_ref_data((x))[1])
+#define external_thing_ref_numbers(thing) \
+ (&external_thing_ref_data(thing)[1])
+
#else
#define internal_ref_no_of_numbers(x) (internal_ref_data_words((x)))
+#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t))
#define internal_ref_numbers(x) (internal_ref_data((x)))
+#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t))
#define external_ref_no_of_numbers(x) (external_ref_data_words((x)))
+#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t)))
#define external_ref_numbers(x) (external_ref_data((x)))
+#define external_thing_ref_numbers(t) (external_thing_ref_data((t)))
#endif
@@ -311,6 +324,8 @@ extern int erts_use_r9_pids_ports;
: external_ref_channel_no((x)))
#define is_ref(x) (is_internal_ref((x)) \
|| is_external_ref((x)))
+#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \
+ || is_external_ref_rel((x),Base))
#define is_not_ref(x) (!is_ref(x))
#endif
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index d927415f37..8479e56710 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -824,7 +824,7 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp)
}
#endif /* inline */
-Eterm* erts_heap_alloc(Process* p, Uint need);
+Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra);
#ifdef CHECK_FOR_HOLES
Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz);
#endif
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 7a7042abe4..68fda01597 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -261,139 +261,139 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x)
static void
heap_dump(int to, void *to_arg, Eterm x)
{
+ DeclareTmpHeapNoproc(last,1);
+ Eterm* next = last;
Eterm* ptr;
- Eterm last = OUR_NIL;
- Eterm* next = &last;
if (is_immed(x) || is_CP(x)) {
return;
}
-
- again:
- if (x == OUR_NIL) { /* We are done. */
- return;
- } if (is_CP(x)) {
- next = (Eterm *) EXPAND_POINTER(x);
- } else if (is_list(x)) {
- ptr = list_val(x);
- if (ptr[0] != OUR_NIL) {
- erts_print(to, to_arg, ADDR_FMT ":l", ptr);
- dump_element(to, to_arg, ptr[0]);
- erts_putc(to, to_arg, '|');
- dump_element(to, to_arg, ptr[1]);
- erts_putc(to, to_arg, '\n');
- if (is_immed(ptr[1])) {
- ptr[1] = make_small(0);
- }
- x = ptr[0];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
- next = ptr + 1;
- goto again;
- }
- } else if (is_boxed(x)) {
- Eterm hdr;
-
- ptr = boxed_val(x);
- hdr = *ptr;
- if (hdr != OUR_NIL) { /* If not visited */
- erts_print(to, to_arg, ADDR_FMT ":", ptr);
- if (is_arity_value(hdr)) {
- Uint i;
- Uint arity = arityval(hdr);
-
- erts_print(to, to_arg, "t" WORD_FMT ":", arity);
- for (i = 1; i <= arity; i++) {
- dump_element(to, to_arg, ptr[i]);
- if (is_immed(ptr[i])) {
- ptr[i] = make_small(0);
- }
- if (i < arity) {
- erts_putc(to, to_arg, ',');
- }
- }
+ UseTmpHeapNoproc(1);
+ *last = OUR_NIL;
+
+ while (x != OUR_NIL) {
+ if (is_CP(x)) {
+ next = (Eterm *) EXPAND_POINTER(x);
+ } else if (is_list(x)) {
+ ptr = list_val(x);
+ if (ptr[0] != OUR_NIL) {
+ erts_print(to, to_arg, ADDR_FMT ":l", ptr);
+ dump_element(to, to_arg, ptr[0]);
+ erts_putc(to, to_arg, '|');
+ dump_element(to, to_arg, ptr[1]);
erts_putc(to, to_arg, '\n');
- if (arity == 0) {
- ptr[0] = OUR_NIL;
- } else {
- x = ptr[arity];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
- next = ptr + arity - 1;
- goto again;
+ if (is_immed(ptr[1])) {
+ ptr[1] = make_small(0);
}
- } else if (hdr == HEADER_FLONUM) {
- FloatDef f;
- char sbuf[31];
- int i;
-
- GET_DOUBLE_DATA((ptr+1), f);
- i = sys_double_to_chars(f.fd, (char*) sbuf);
- sys_memset(sbuf+i, 0, 31-i);
- erts_print(to, to_arg, "F%X:%s\n", i, sbuf);
- *ptr = OUR_NIL;
- } else if (_is_bignum_header(hdr)) {
- erts_print(to, to_arg, "B%T\n", x);
- *ptr = OUR_NIL;
- } else if (is_binary_header(hdr)) {
- Uint tag = thing_subtag(hdr);
- Uint size = binary_size(x);
- Uint i;
-
- if (tag == HEAP_BINARY_SUBTAG) {
- byte* p;
-
- erts_print(to, to_arg, "Yh%X:", size);
- p = binary_bytes(x);
- for (i = 0; i < size; i++) {
- erts_print(to, to_arg, "%02X", p[i]);
+ x = ptr[0];
+ ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ next = ptr + 1;
+ continue;
+ }
+ } else if (is_boxed(x)) {
+ Eterm hdr;
+
+ ptr = boxed_val(x);
+ hdr = *ptr;
+ if (hdr != OUR_NIL) { /* If not visited */
+ erts_print(to, to_arg, ADDR_FMT ":", ptr);
+ if (is_arity_value(hdr)) {
+ Uint i;
+ Uint arity = arityval(hdr);
+
+ erts_print(to, to_arg, "t" WORD_FMT ":", arity);
+ for (i = 1; i <= arity; i++) {
+ dump_element(to, to_arg, ptr[i]);
+ if (is_immed(ptr[i])) {
+ ptr[i] = make_small(0);
+ }
+ if (i < arity) {
+ erts_putc(to, to_arg, ',');
+ }
}
- } else if (tag == REFC_BINARY_SUBTAG) {
- ProcBin* pb = (ProcBin *) binary_val(x);
- Binary* val = pb->val;
-
- if (erts_smp_atomic_xchg(&val->refc, 0) != 0) {
- val->flags = (UWord) all_binaries;
- all_binaries = val;
+ erts_putc(to, to_arg, '\n');
+ if (arity == 0) {
+ ptr[0] = OUR_NIL;
+ } else {
+ x = ptr[arity];
+ ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ next = ptr + arity - 1;
+ continue;
}
- erts_print(to, to_arg, "Yc%X:%X:%X", val,
- pb->bytes - (byte *)val->orig_bytes,
- size);
- } else if (tag == SUB_BINARY_SUBTAG) {
- ErlSubBin* Sb = (ErlSubBin *) binary_val(x);
- Eterm* real_bin = binary_val(Sb->orig);
- void* val;
-
- if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) {
- ProcBin* pb = (ProcBin *) real_bin;
- val = pb->val;
- } else { /* Heap binary */
- val = real_bin;
+ } else if (hdr == HEADER_FLONUM) {
+ FloatDef f;
+ char sbuf[31];
+ int i;
+
+ GET_DOUBLE_DATA((ptr+1), f);
+ i = sys_double_to_chars(f.fd, (char*) sbuf);
+ sys_memset(sbuf+i, 0, 31-i);
+ erts_print(to, to_arg, "F%X:%s\n", i, sbuf);
+ *ptr = OUR_NIL;
+ } else if (_is_bignum_header(hdr)) {
+ erts_print(to, to_arg, "B%T\n", x);
+ *ptr = OUR_NIL;
+ } else if (is_binary_header(hdr)) {
+ Uint tag = thing_subtag(hdr);
+ Uint size = binary_size(x);
+ Uint i;
+
+ if (tag == HEAP_BINARY_SUBTAG) {
+ byte* p;
+
+ erts_print(to, to_arg, "Yh%X:", size);
+ p = binary_bytes(x);
+ for (i = 0; i < size; i++) {
+ erts_print(to, to_arg, "%02X", p[i]);
+ }
+ } else if (tag == REFC_BINARY_SUBTAG) {
+ ProcBin* pb = (ProcBin *) binary_val(x);
+ Binary* val = pb->val;
+
+ if (erts_smp_atomic_xchg(&val->refc, 0) != 0) {
+ val->flags = (UWord) all_binaries;
+ all_binaries = val;
+ }
+ erts_print(to, to_arg, "Yc%X:%X:%X", val,
+ pb->bytes - (byte *)val->orig_bytes,
+ size);
+ } else if (tag == SUB_BINARY_SUBTAG) {
+ ErlSubBin* Sb = (ErlSubBin *) binary_val(x);
+ Eterm* real_bin = binary_val(Sb->orig);
+ void* val;
+
+ if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) {
+ ProcBin* pb = (ProcBin *) real_bin;
+ val = pb->val;
+ } else { /* Heap binary */
+ val = real_bin;
+ }
+ erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size);
}
- erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size);
+ erts_putc(to, to_arg, '\n');
+ *ptr = OUR_NIL;
+ } else if (is_external_pid_header(hdr)) {
+ erts_print(to, to_arg, "P%T\n", x);
+ *ptr = OUR_NIL;
+ } else if (is_external_port_header(hdr)) {
+ erts_print(to, to_arg, "p<%bpu.%bpu>\n",
+ port_channel_no(x), port_number(x));
+ *ptr = OUR_NIL;
+ } else {
+ /*
+ * All other we dump in the external term format.
+ */
+ dump_externally(to, to_arg, x);
+ erts_putc(to, to_arg, '\n');
+ *ptr = OUR_NIL;
}
- erts_putc(to, to_arg, '\n');
- *ptr = OUR_NIL;
- } else if (is_external_pid_header(hdr)) {
- erts_print(to, to_arg, "P%T\n", x);
- *ptr = OUR_NIL;
- } else if (is_external_port_header(hdr)) {
- erts_print(to, to_arg, "p<%bpu.%bpu>\n",
- port_channel_no(x), port_number(x));
- *ptr = OUR_NIL;
- } else {
- /*
- * All other we dump in the external term format.
- */
- dump_externally(to, to_arg, x);
- erts_putc(to, to_arg, '\n');
- *ptr = OUR_NIL;
}
}
+ x = *next;
+ *next = OUR_NIL;
+ next--;
}
-
- x = *next;
- *next = OUR_NIL;
- next--;
- goto again;
+ UnUseTmpHeapNoproc(1);
}
static void
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index c6458a0e45..f77e8b798f 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -58,9 +58,9 @@ do { \
#endif
#if ET_DEBUG
-unsigned tag_val_def_debug(Eterm x, const char *file, unsigned line)
+unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line)
#else
-unsigned tag_val_def(Eterm x)
+unsigned tag_val_def(Wterm x)
#define file __FILE__
#define line __LINE__
#endif
@@ -125,10 +125,10 @@ FUNTY checked_##FUN(ARGTY x, const char *file, unsigned line) \
ET_DEFINE_CHECKED(Eterm,make_boxed,Eterm*,_is_taggable_pointer);
ET_DEFINE_CHECKED(int,is_boxed,Eterm,!is_header);
-ET_DEFINE_CHECKED(Eterm*,boxed_val,Eterm,_boxed_precond);
+ET_DEFINE_CHECKED(Eterm*,boxed_val,Wterm,_boxed_precond);
ET_DEFINE_CHECKED(Eterm,make_list,Eterm*,_is_taggable_pointer);
ET_DEFINE_CHECKED(int,is_not_list,Eterm,!is_header);
-ET_DEFINE_CHECKED(Eterm*,list_val,Eterm,_list_precond);
+ET_DEFINE_CHECKED(Eterm*,list_val,Wterm,_list_precond);
ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small);
ET_DEFINE_CHECKED(Sint,signed_val,Eterm,is_small);
ET_DEFINE_CHECKED(Uint,atom_val,Eterm,is_atom);
@@ -136,34 +136,35 @@ ET_DEFINE_CHECKED(Uint,header_arity,Eterm,is_header);
ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_arity_value);
ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing);
ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing);
-ET_DEFINE_CHECKED(Eterm*,binary_val,Eterm,is_binary);
-ET_DEFINE_CHECKED(Eterm*,fun_val,Eterm,is_fun);
+ET_DEFINE_CHECKED(Eterm*,binary_val,Wterm,is_binary);
+ET_DEFINE_CHECKED(Eterm*,fun_val,Wterm,is_fun);
ET_DEFINE_CHECKED(int,bignum_header_is_neg,Eterm,_is_bignum_header);
ET_DEFINE_CHECKED(Eterm,bignum_header_neg,Eterm,_is_bignum_header);
ET_DEFINE_CHECKED(Uint,bignum_header_arity,Eterm,_is_bignum_header);
-ET_DEFINE_CHECKED(Eterm*,big_val,Eterm,is_big);
-ET_DEFINE_CHECKED(Eterm*,float_val,Eterm,is_float);
-ET_DEFINE_CHECKED(Eterm*,tuple_val,Eterm,is_tuple);
+ET_DEFINE_CHECKED(Eterm*,big_val,Wterm,is_big);
+ET_DEFINE_CHECKED(Eterm*,float_val,Wterm,is_float);
+ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple);
ET_DEFINE_CHECKED(Uint,internal_pid_data,Eterm,is_internal_pid);
ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid);
ET_DEFINE_CHECKED(Uint,internal_port_data,Eterm,is_internal_port);
ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port);
-ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Eterm,is_internal_ref);
-ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Eterm,is_internal_ref);
-ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Eterm,is_internal_ref);
+ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref);
+ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref);
+ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref);
ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref);
-ET_DEFINE_CHECKED(Eterm*,external_val,Eterm,is_external);
-ET_DEFINE_CHECKED(Uint,external_data_words,Eterm,is_external);
-ET_DEFINE_CHECKED(Uint,external_pid_data_words,Eterm,is_external_pid);
-ET_DEFINE_CHECKED(Uint,external_pid_data,Eterm,is_external_pid);
-ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Eterm,is_external_pid);
-ET_DEFINE_CHECKED(Uint,external_port_data_words,Eterm,is_external_port);
-ET_DEFINE_CHECKED(Uint,external_port_data,Eterm,is_external_port);
-ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Eterm,is_external_port);
-ET_DEFINE_CHECKED(Uint,external_ref_data_words,Eterm,is_external_ref);
-ET_DEFINE_CHECKED(Uint32*,external_ref_data,Eterm,is_external_ref);
+ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external);
+ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external);
+ET_DEFINE_CHECKED(Uint,external_pid_data_words,Wterm,is_external_pid);
+ET_DEFINE_CHECKED(Uint,external_pid_data,Wterm,is_external_pid);
+ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Wterm,is_external_pid);
+ET_DEFINE_CHECKED(Uint,external_port_data_words,Wterm,is_external_port);
+ET_DEFINE_CHECKED(Uint,external_port_data,Wterm,is_external_port);
+ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Wterm,is_external_port);
+ET_DEFINE_CHECKED(Uint,external_ref_data_words,Wterm,is_external_ref);
+ET_DEFINE_CHECKED(Uint32*,external_ref_data,Wterm,is_external_ref);
ET_DEFINE_CHECKED(struct erl_node_*,external_ref_node,Eterm,is_external_ref);
-ET_DEFINE_CHECKED(Eterm*,export_val,Eterm,is_export);
+ET_DEFINE_CHECKED(Eterm*,export_val,Wterm,is_export);
+ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr);
ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer);
ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP);
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 815cc1beae..1d75fa313c 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -22,6 +22,8 @@
#include "sys.h" /* defines HALFWORD_HEAP */
+typedef UWord Wterm; /* Full word terms */
+
#if HALFWORD_HEAP
# define HEAP_ON_C_STACK 0
# if HALFWORD_ASSERT
@@ -204,7 +206,7 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm)
#define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED)
#endif
#define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED)))
-_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm)
#define boxed_val(x) _ET_APPLY(boxed_val,(x))
/* cons cell ("list") access methods */
@@ -226,7 +228,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm)
#define _list_precond(x) (is_list(x))
#endif
#define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST))
-_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define list_val(x) _ET_APPLY(list_val,(x))
#define CONS(hp, car, cdr) \
@@ -240,6 +242,8 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Eterm)
#define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/
#define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm)))
#define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/
+#define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs))
+#define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/
/* fixnum ("small") access methods */
#if defined(ARCH_64) && !HALFWORD_HEAP
@@ -305,6 +309,7 @@ _ET_DECLARE_CHECKED(Uint,arityval,Eterm)
/* thing access methods */
#define is_thing(x) (is_header((x)) && header_is_thing((x)))
+#define is_thing_ptr(t) (is_thing((t)->header))
#define _unchecked_thing_arityval(x) _unchecked_header_arity((x))
_ET_DECLARE_CHECKED(Uint,thing_arityval,Eterm)
#define thing_arityval(x) _ET_APPLY(thing_arityval,(x))
@@ -339,7 +344,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
#define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x))))
#define is_not_binary(x) (!is_binary((x)))
#define _unchecked_binary_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,binary_val,Wterm)
#define binary_val(x) _ET_APPLY(binary_val,(x))
/* process binaries stuff (special case of binaries) */
@@ -356,7 +361,7 @@ _ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm)
#define is_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x))))
#define is_not_fun(x) (!is_fun((x)))
#define _unchecked_fun_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm)
#define fun_val(x) _ET_APPLY(fun_val,(x))
/* export access methods */
@@ -364,7 +369,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm)
#define is_export(x) (is_boxed((x)) && is_export_header(*boxed_val((x))))
#define is_not_export(x) (!is_export((x)))
#define _unchecked_export_val(x) _unchecked_boxed_val(x)
-_ET_DECLARE_CHECKED(Eterm*,export_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm)
#define export_val(x) _ET_APPLY(export_val,(x))
#define is_export_header(x) ((x) == HEADER_EXPORT)
#if HALFWORD_HEAP
@@ -391,7 +396,7 @@ _ET_DECLARE_CHECKED(Uint,bignum_header_arity,Eterm)
#define is_big(x) (is_boxed((x)) && _is_bignum_header(*boxed_val((x))))
#define is_not_big(x) (!is_big((x)))
#define _unchecked_big_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,big_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,big_val,Wterm)
#define big_val(x) _ET_APPLY(big_val,(x))
/* flonum ("float") access methods */
@@ -404,7 +409,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Eterm)
#define is_float(x) (is_boxed((x)) && *boxed_val((x)) == HEADER_FLONUM)
#define is_not_float(x) (!is_float(x))
#define _unchecked_float_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,float_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,float_val,Wterm)
#define float_val(x) _ET_APPLY(float_val,(x))
/* Float definition for byte and word access */
@@ -422,15 +427,16 @@ typedef union float_def
} FloatDef;
#if defined(ARCH_64) && !HALFWORD_HEAP
-#define GET_DOUBLE(x, f) (f).fdw = *(float_val(x)+1)
+
+#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1)
#define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \
*((x)+1) = (f).fdw
#define GET_DOUBLE_DATA(p, f) (f).fdw = *((Uint *) (p))
#define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fdw
#else
-#define GET_DOUBLE(x, f) (f).fw[0] = *(float_val(x)+1), \
- (f).fw[1] = *(float_val(x)+2)
+#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fw[0] = *((fval)+1), \
+ (f).fw[1] = *((fval)+2)
#define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \
*((x)+1) = (f).fw[0], \
@@ -440,6 +446,9 @@ typedef union float_def
#define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fw[0],\
*(((Uint *) (p))+1) = (f).fw[1]
#endif
+
+#define GET_DOUBLE(x, f) FLOAT_VAL_GET_DOUBLE(float_val(x), f)
+
#define DOUBLE_DATA_WORDS (sizeof(ieee754_8)/sizeof(Eterm))
#define FLOAT_SIZE_OBJECT (DOUBLE_DATA_WORDS+1)
@@ -451,7 +460,7 @@ typedef union float_def
(is_boxed((x)) && *boxed_val((x)) == make_arityval((a)))
#define is_not_tuple_arity(x, a) (!is_tuple_arity((x),(a)))
#define _unchecked_tuple_val(x) _unchecked_boxed_val(x)
-_ET_DECLARE_CHECKED(Eterm*,tuple_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm)
#define tuple_val(x) _ET_APPLY(tuple_val,(x))
#define TUPLE0(t) \
@@ -790,21 +799,24 @@ do { \
((RefThing*) internal_ref_val(x))
#define is_internal_ref(x) \
- (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x))))
+ (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x))))
+
#define is_not_internal_ref(x) \
(!is_internal_ref((x)))
#define _unchecked_internal_ref_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm)
#define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x))
+#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t)))
#define _unchecked_internal_ref_data_words(x) \
(_unchecked_thing_arityval(*_unchecked_internal_ref_val(x)))
-_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Eterm)
+_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm)
#define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x))
-#define _unchecked_internal_ref_data(x) (_unchecked_ref_thing_ptr(x)->data.ui32)
-_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Eterm)
+#define internal_thing_ref_data(thing) ((thing)->data.ui32)
+#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x)))
+_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm)
#define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x))
#define _unchecked_internal_ref_node(x) erts_this_node
@@ -889,14 +901,14 @@ typedef struct external_thing_ {
#define is_external_header(x) \
(((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_EXTERNAL_PID)
-#define is_external(x) \
- (is_boxed((x)) && is_external_header(*boxed_val((x))))
+#define is_external(x) (is_boxed((x)) && is_external_header(*boxed_val((x))))
+
#define is_external_pid(x) \
(is_boxed((x)) && is_external_pid_header(*boxed_val((x))))
#define is_external_port(x) \
- (is_boxed((x)) && is_external_port_header(*boxed_val((x))))
-#define is_external_ref(x) \
- (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x))))
+ (is_boxed((x)) && is_external_port_header(*boxed_val((x))))
+
+#define is_external_ref(x) (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x))))
#define _unchecked_is_external(x) \
(_unchecked_is_boxed((x)) && is_external_header(*_unchecked_boxed_val((x))))
@@ -914,17 +926,21 @@ typedef struct external_thing_ {
#define make_external_ref make_external
#define _unchecked_external_val(x) _unchecked_boxed_val((x))
-_ET_DECLARE_CHECKED(Eterm*,external_val,Eterm)
+_ET_DECLARE_CHECKED(Eterm*,external_val,Wterm)
#define external_val(x) _ET_APPLY(external_val,(x))
#define external_thing_ptr(x) ((ExternalThing *) external_val((x)))
#define _unchecked_external_thing_ptr(x) \
((ExternalThing *) _unchecked_external_val((x)))
+#define _unchecked_external_thing_data_words(thing) \
+ (_unchecked_thing_arityval((thing)->header) + (1 - EXTERNAL_THING_HEAD_SIZE))
+_ET_DECLARE_CHECKED(Uint,external_thing_data_words,ExternalThing*)
+#define external_thing_data_words(thing) _ET_APPLY(external_thing_data_words,(thing))
+
#define _unchecked_external_data_words(x) \
- (_unchecked_thing_arityval(_unchecked_external_thing_ptr((x))->header) \
- + (1 - EXTERNAL_THING_HEAD_SIZE))
-_ET_DECLARE_CHECKED(Uint,external_data_words,Eterm)
+ _unchecked_external_thing_data_words(_unchecked_external_thing_ptr((x)))
+_ET_DECLARE_CHECKED(Uint,external_data_words,Wterm)
#define external_data_words(x) _ET_APPLY(external_data_words,(x))
#define _unchecked_external_data(x) (_unchecked_external_thing_ptr((x))->data.ui)
@@ -935,15 +951,15 @@ _ET_DECLARE_CHECKED(Uint,external_data_words,Eterm)
#define _unchecked_external_pid_data_words(x) \
_unchecked_external_data_words((x))
-_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Eterm)
+_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Wterm)
#define external_pid_data_words(x) _ET_APPLY(external_pid_data_words,(x))
#define _unchecked_external_pid_data(x) _unchecked_external_data((x))[0]
-_ET_DECLARE_CHECKED(Uint,external_pid_data,Eterm)
+_ET_DECLARE_CHECKED(Uint,external_pid_data,Wterm)
#define external_pid_data(x) _ET_APPLY(external_pid_data,(x))
#define _unchecked_external_pid_node(x) _unchecked_external_node((x))
-_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm)
+_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Wterm)
#define external_pid_node(x) _ET_APPLY(external_pid_node,(x))
#define external_pid_number(x) _GET_PID_NUM(external_pid_data((x)))
@@ -951,27 +967,29 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm)
#define _unchecked_external_port_data_words(x) \
_unchecked_external_data_words((x))
-_ET_DECLARE_CHECKED(Uint,external_port_data_words,Eterm)
+_ET_DECLARE_CHECKED(Uint,external_port_data_words,Wterm)
#define external_port_data_words(x) _ET_APPLY(external_port_data_words,(x))
#define _unchecked_external_port_data(x) _unchecked_external_data((x))[0]
-_ET_DECLARE_CHECKED(Uint,external_port_data,Eterm)
+_ET_DECLARE_CHECKED(Uint,external_port_data,Wterm)
#define external_port_data(x) _ET_APPLY(external_port_data,(x))
#define _unchecked_external_port_node(x) _unchecked_external_node((x))
-_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Eterm)
+_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Wterm)
#define external_port_node(x) _ET_APPLY(external_port_node,(x))
#define external_port_number(x) _GET_PORT_NUM(external_port_data((x)))
#define _unchecked_external_ref_data_words(x) \
_unchecked_external_data_words((x))
-_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Eterm)
+_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Wterm)
#define external_ref_data_words(x) _ET_APPLY(external_ref_data_words,(x))
+#define external_thing_ref_data_words(thing) external_thing_data_words(thing)
#define _unchecked_external_ref_data(x) (_unchecked_external_thing_ptr((x))->data.ui32)
-_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Eterm)
+_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Wterm)
#define external_ref_data(x) _ET_APPLY(external_ref_data,(x))
+#define external_thing_ref_data(thing) ((thing)->data.ui32)
#define _unchecked_external_ref_node(x) _unchecked_external_node((x))
_ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
@@ -1083,10 +1101,10 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint)
#define SMALL_DEF 0xf
#if ET_DEBUG
-extern unsigned tag_val_def_debug(Eterm, const char*, unsigned);
+extern unsigned tag_val_def_debug(Wterm, const char*, unsigned);
#define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__)
#else
-extern unsigned tag_val_def(Eterm);
+extern unsigned tag_val_def(Wterm);
#endif
#define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y)))
@@ -1102,5 +1120,81 @@ extern unsigned tag_val_def(Eterm);
#define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF)
#define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF)
+#if HALFWORD_HEAP
+#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE)))
+#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE))
+
+#else /* HALFWORD_HEAP */
+
+#define ptr2rel(PTR,BASE) (PTR)
+#define rterm2wterm(REL,BASE) (REL)
+
+#endif /* !HALFWORD_HEAP */
+
+#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE))
+#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE))
+#define make_fun_rel make_boxed_rel
+#define make_binary_rel make_boxed_rel
+#define make_tuple_rel make_boxed_rel
+#define make_external_rel make_boxed_rel
+#define make_internal_ref_rel make_boxed_rel
+
+#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE))
+#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE))
+#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE))
+#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE))
+#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE))
+#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE))
+#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE))
+#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE))
+#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE))
+
+#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE))
+#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE))
+
+#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE))
+#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE))
+
+#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE))
+#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE))
+#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE))
+
+#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE))
+#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE))
+#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE))
+#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE))
+#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE))
+#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE))
+
+#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f)
+
+#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE))
+#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE))
+#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE))
+#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE))
+#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE))
+
+#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE))
+
+
+#if HALFWORD_HEAP
+ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
+{
+ /* If bases differ, assume a and b are on different "heaps",
+ ie can only be same if immed */
+ ASSERT(a_base == b_base || is_immed(a) || is_immed(b)
+ || rterm2wterm(a,a_base) != rterm2wterm(b,b_base));
+
+ return a == b && (a_base == b_base || is_immed(a));
+}
+#endif
+
+#else /* !HALFWORD_HEAP */
+#define is_same(A,A_BASE,B,B_BASE) ((A)==(B))
+#endif
+
#endif /* __ERL_TERM_H */
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 3043bb1e8c..c0397ca6c3 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -1668,7 +1668,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
return_flags = 0;
if (match_spec) {
pam_result = erts_match_set_run(p, match_spec, args, arity,
- &return_flags);
+ ERTS_PAM_TMP_RESULT, &return_flags);
if (is_non_value(pam_result)) {
erts_match_set_release_result(p);
#if !HEAP_ON_C_STACK
@@ -1815,7 +1815,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
return_flags = 0;
if (match_spec) {
pam_result = erts_match_set_run(p, match_spec, args, arity,
- &return_flags);
+ ERTS_PAM_TMP_RESULT, &return_flags);
if (is_non_value(pam_result)) {
erts_match_set_release_result(p);
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 5b42a2ce11..e7fd144ec3 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -120,14 +120,15 @@
* Allocate heap memory, first on the ordinary heap;
* failing that, in a heap fragment.
*/
-#define HAlloc(p, sz) \
+#define HAllocX(p, sz, xtra) \
(ASSERT_EXPR((sz) >= 0), \
ErtsHAllocLockCheck(p), \
(IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
- ? erts_heap_alloc((p),(sz)) \
+ ? erts_heap_alloc((p),(sz),(xtra)) \
: (INIT_HEAP_MEM(p,sz), \
HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
+#define HAlloc(P, SZ) HAllocX(P,SZ,0)
#define HRelease(p, endp, ptr) \
if ((ptr) == (endp)) { \
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index e8a9d5f32f..bd540eaaa6 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -890,9 +890,31 @@ void erl_error(char*, va_list);
/* copy.c */
void init_copy(void);
Eterm copy_object(Eterm, Process*);
+
+#if HALFWORD_HEAP
+Uint size_object_rel(Eterm, Eterm*);
+# define size_object(A) size_object_rel(A,NULL)
+
+Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base);
+# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL)
+
+Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base);
+# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL)
+
+#else /* !HALFWORD_HEAP */
+
Uint size_object(Eterm);
+# define size_object_rel(A,B) size_object(A)
+
Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
+# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH)
+
Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
+# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D)
+
+#endif
+
+
void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
Eterm* refs, unsigned nrefs);
@@ -1483,16 +1505,30 @@ void erts_init_utils_mem(void);
erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint);
void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *);
+#if HALFWORD_HEAP
+int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
+# define eq(A,B) eq_rel(A,NULL,B,NULL)
+#else
int eq(Eterm, Eterm);
+# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B)
+#endif
+
#define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y))))
+#if HALFWORD_HEAP
+Sint cmp_rel(Eterm, Eterm*, Eterm, Eterm*);
+#define CMP(A,B) cmp_rel(A,NULL,B,NULL)
+#else
Sint cmp(Eterm, Eterm);
-#define cmp_lt(a,b) (cmp((a),(b)) < 0)
-#define cmp_le(a,b) (cmp((a),(b)) <= 0)
-#define cmp_eq(a,b) (cmp((a),(b)) == 0)
-#define cmp_ne(a,b) (cmp((a),(b)) != 0)
-#define cmp_ge(a,b) (cmp((a),(b)) >= 0)
-#define cmp_gt(a,b) (cmp((a),(b)) > 0)
+#define cmp_rel(A,A_BASE,B,B_BASE) cmp(A,B)
+#define CMP(A,B) cmp(A,B)
+#endif
+#define cmp_lt(a,b) (CMP((a),(b)) < 0)
+#define cmp_le(a,b) (CMP((a),(b)) <= 0)
+#define cmp_eq(a,b) (CMP((a),(b)) == 0)
+#define cmp_ne(a,b) (CMP((a),(b)) != 0)
+#define cmp_ge(a,b) (CMP((a),(b)) >= 0)
+#define cmp_gt(a,b) (CMP((a),(b)) > 0)
#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b)))
#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b)))
@@ -1721,8 +1757,15 @@ do { \
extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr);
Eterm erts_match_set_lint(Process *p, Eterm matchexpr);
extern void erts_match_set_release_result(Process* p);
+
+enum erts_pam_run_flags {
+ ERTS_PAM_TMP_RESULT=0,
+ ERTS_PAM_COPY_RESULT=1,
+ ERTS_PAM_CONTIGUOUS_TUPLE=2
+};
extern Eterm erts_match_set_run(Process *p, Binary *mpsp,
Eterm *args, int num_args,
+ enum erts_pam_run_flags in_flags,
Uint32 *return_flags);
extern Eterm erts_match_set_get_source(Binary *mpsp);
extern void erts_match_prog_foreach_offheap(Binary *b,
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index dff2dc37a2..b1cd683b3b 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -225,14 +225,14 @@ int real_printf(const char *fmt, ...);
#else
#error Neither 32 nor 64 bit architecture
#endif
-#ifdef ARCH_64
-# ifdef HALFWORD_HEAP_EMULATOR
+#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR)
# define HALFWORD_HEAP 1
# define HALFWORD_ASSERT 0
-# else
+# define ASSERT_HALFWORD(COND) ASSERT(COND)
+#else
# define HALFWORD_HEAP 0
# define HALFWORD_ASSERT 0
-# endif
+# define ASSERT_HALFWORD(COND)
#endif
#if SIZEOF_VOID_P != SIZEOF_SIZE_T
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 1d60b54d21..f531d1430b 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -91,7 +91,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq)
Eterm*
-erts_heap_alloc(Process* p, Uint need)
+erts_heap_alloc(Process* p, Uint need, Uint xtra)
{
ErlHeapFragment* bp;
Eterm* htop;
@@ -117,7 +117,7 @@ erts_heap_alloc(Process* p, Uint need)
p->space_verified_from = NULL;
#endif /* FORCE_HEAP_FRAGS */
- n = need;
+ n = need + xtra;
bp = MBUF(p);
if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) {
Eterm* ret = bp->mem + bp->used_size;
@@ -153,7 +153,7 @@ erts_heap_alloc(Process* p, Uint need)
bp->next = MBUF(p);
MBUF(p) = bp;
bp->alloc_size = n;
- bp->used_size = n;
+ bp->used_size = need;
MBUF_SIZE(p) += n;
bp->off_heap.first = NULL;
bp->off_heap.overhead = 0;
@@ -1894,34 +1894,36 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp)
erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp);
}
-
/* eq and cmp are written as separate functions a eq is a little faster */
/*
* Test for equality of two terms.
* Returns 0 if not equal, or a non-zero value otherwise.
*/
-
+#if HALFWORD_HEAP
+int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
+#else
int eq(Eterm a, Eterm b)
+#endif
{
DECLARE_WSTACK(stack);
Sint sz;
Eterm* aa;
- Eterm* bb;
+ Eterm* bb;
tailrecur:
- if (a == b) goto pop_next;
+ if (is_same(a, a_base, b, b_base)) goto pop_next;
tailrecur_ne:
switch (primary_tag(a)) {
case TAG_PRIMARY_LIST:
if (is_list(b)) {
- Eterm* aval = list_val(a);
- Eterm* bval = list_val(b);
+ Eterm* aval = list_val_rel(a, a_base);
+ Eterm* bval = list_val_rel(b, b_base);
while (1) {
Eterm atmp = CAR(aval);
Eterm btmp = CAR(bval);
- if (atmp != btmp) {
+ if (!is_same(atmp,a_base,btmp,b_base)) {
WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval));
a = atmp;
b = btmp;
@@ -1929,7 +1931,7 @@ tailrecur_ne:
}
atmp = CDR(aval);
btmp = CDR(bval);
- if (atmp == btmp) {
+ if (is_same(atmp,a_base,btmp,b_base)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -1937,22 +1939,22 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aval = list_val(atmp);
- bval = list_val(btmp);
+ aval = list_val_rel(atmp, a_base);
+ bval = list_val_rel(btmp, b_base);
}
}
break; /* not equal */
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val(a);
+ Eterm hdr = *boxed_val_rel(a,a_base);
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
- aa = tuple_val(a);
- if (!is_boxed(b) || *boxed_val(b) != *aa)
+ aa = tuple_val_rel(a, a_base);
+ if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
goto not_equal;
- bb = tuple_val(b);
+ bb = tuple_val_rel(b,b_base);
if ((sz = arityval(*aa)) == 0) goto pop_next;
++aa;
++bb;
@@ -1971,16 +1973,16 @@ tailrecur_ne:
Uint a_bitoffs;
Uint b_bitoffs;
- if (is_not_binary(b)) {
+ if (!is_binary_rel(b,b_base)) {
goto not_equal;
}
- a_size = binary_size(a);
- b_size = binary_size(b);
+ a_size = binary_size_rel(a,a_base);
+ b_size = binary_size_rel(b,b_base);
if (a_size != b_size) {
goto not_equal;
}
- ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
- ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
+ ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
+ ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next;
} else if (a_bitsize == b_bitsize) {
@@ -1991,9 +1993,9 @@ tailrecur_ne:
}
case EXPORT_SUBTAG:
{
- if (is_export(b)) {
- Export* a_exp = *((Export **) (export_val(a) + 1));
- Export* b_exp = *((Export **) (export_val(b) + 1));
+ if (is_export_rel(b,b_base)) {
+ Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
+ Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
if (a_exp == b_exp) goto pop_next;
}
break; /* not equal */
@@ -2003,10 +2005,10 @@ tailrecur_ne:
ErlFunThing* f1;
ErlFunThing* f2;
- if (is_not_fun(b))
+ if (!is_fun_rel(b,b_base))
goto not_equal;
- f1 = (ErlFunThing *) fun_val(a);
- f2 = (ErlFunThing *) fun_val(b);
+ f1 = (ErlFunThing *) fun_val_rel(a,a_base);
+ f2 = (ErlFunThing *) fun_val_rel(b,b_base);
if (f1->fe->module != f2->fe->module ||
f1->fe->old_index != f2->fe->old_index ||
f1->fe->old_uniq != f2->fe->old_uniq ||
@@ -2024,15 +2026,15 @@ tailrecur_ne:
ExternalThing *ap;
ExternalThing *bp;
- if(is_not_external(b))
+ if(!is_external_rel(b,b_base))
goto not_equal;
- ap = external_thing_ptr(a);
- bp = external_thing_ptr(b);
+ ap = external_thing_ptr_rel(a,a_base);
+ bp = external_thing_ptr_rel(b,b_base);
if(ap->header == bp->header && ap->node == bp->node) {
- ASSERT(1 == external_data_words(a));
- ASSERT(1 == external_data_words(b));
+ ASSERT(1 == external_data_words_rel(a,a_base));
+ ASSERT(1 == external_data_words_rel(b,b_base));
if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next;
}
@@ -2050,27 +2052,36 @@ tailrecur_ne:
Uint alen;
Uint blen;
Uint i;
+ ExternalThing* athing;
+ ExternalThing* bthing;
- if(is_not_external_ref(b))
+ if(!is_external_ref_rel(b,b_base))
goto not_equal;
- if(external_node(a) != external_node(b))
+ athing = external_thing_ptr_rel(a,a_base);
+ bthing = external_thing_ptr_rel(b,b_base);
+
+ if(athing->node != bthing->node)
goto not_equal;
- anum = external_ref_numbers(a);
- bnum = external_ref_numbers(b);
- alen = external_ref_no_of_numbers(a);
- blen = external_ref_no_of_numbers(b);
+ anum = external_thing_ref_numbers(athing);
+ bnum = external_thing_ref_numbers(bthing);
+ alen = external_thing_ref_no_of_numbers(athing);
+ blen = external_thing_ref_no_of_numbers(bthing);
goto ref_common;
case REF_SUBTAG:
-
- if (is_not_internal_ref(b))
+ if (!is_internal_ref_rel(b,b_base))
goto not_equal;
- alen = internal_ref_no_of_numbers(a);
- blen = internal_ref_no_of_numbers(b);
- anum = internal_ref_numbers(a);
- bnum = internal_ref_numbers(b);
+
+ {
+ RefThing* athing = ref_thing_ptr_rel(a,a_base);
+ RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ alen = internal_thing_ref_no_of_numbers(athing);
+ blen = internal_thing_ref_no_of_numbers(bthing);
+ anum = internal_thing_ref_numbers(athing);
+ bnum = internal_thing_ref_numbers(bthing);
+ }
ref_common:
ASSERT(alen > 0 && blen > 0);
@@ -2115,10 +2126,10 @@ tailrecur_ne:
{
int i;
- if (is_not_big(b))
+ if (!is_big_rel(b,b_base))
goto not_equal;
- aa = big_val(a); /* get pointer to thing */
- bb = big_val(b);
+ aa = big_val_rel(a,a_base);
+ bb = big_val_rel(b,b_base);
if (*aa != *bb)
goto not_equal;
i = BIG_ARITY(aa);
@@ -2133,9 +2144,9 @@ tailrecur_ne:
FloatDef af;
FloatDef bf;
- if (is_float(b)) {
- GET_DOUBLE(a, af);
- GET_DOUBLE(b, bf);
+ if (is_float_rel(b,b_base)) {
+ GET_DOUBLE_REL(a, af, a_base);
+ GET_DOUBLE_REL(b, bf, b_base);
if (af.fd == bf.fd) goto pop_next;
}
break; /* not equal */
@@ -2154,7 +2165,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */
Eterm* bp = bb;
Sint i = sz;
for (;;) {
- if (*ap != *bp) break;
+ if (!is_same(*ap,a_base,*bp,b_base)) break;
if (--i == 0) goto pop_next;
++ap;
++bp;
@@ -2243,7 +2254,11 @@ static int cmp_atoms(Eterm a, Eterm b)
bb->name+3, bb->len-3);
}
+#if HALFWORD_HEAP
+Sint cmp_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
+#else
Sint cmp(Eterm a, Eterm b)
+#endif
{
DECLARE_WSTACK(stack);
Eterm* aa;
@@ -2277,7 +2292,7 @@ Sint cmp(Eterm a, Eterm b)
tailrecur:
- if (a == b) { /* Equal values or pointers. */
+ if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */
goto pop_next;
}
tailrecur_ne:
@@ -2303,9 +2318,9 @@ tailrecur_ne:
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port(b)) {
- bnode = external_port_node(b);
- bdata = external_port_data(b);
+ } else if (is_external_port_rel(b,b_base)) {
+ bnode = external_port_node_rel(b,b_base);
+ bdata = external_port_data_rel(b,b_base);
} else {
a_tag = PORT_DEF;
goto mixed_types;
@@ -2321,9 +2336,9 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid(b)) {
- bnode = external_pid_node(b);
- bdata = external_pid_data(b);
+ } else if (is_external_pid_rel(b,b_base)) {
+ bnode = external_pid_node_rel(b,b_base);
+ bdata = external_pid_data_rel(b,b_base);
} else {
a_tag = PID_DEF;
goto mixed_types;
@@ -2356,12 +2371,12 @@ tailrecur_ne:
a_tag = LIST_DEF;
goto mixed_types;
}
- aa = list_val(a);
- bb = list_val(b);
+ aa = list_val_rel(a,a_base);
+ bb = list_val_rel(b,b_base);
while (1) {
Eterm atmp = CAR(aa);
Eterm btmp = CAR(bb);
- if (atmp != btmp) {
+ if (!is_same(atmp,a_base,btmp,b_base)) {
WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa));
a = atmp;
b = btmp;
@@ -2369,7 +2384,7 @@ tailrecur_ne:
}
atmp = CDR(aa);
btmp = CDR(bb);
- if (atmp == btmp) {
+ if (is_same(atmp,a_base,btmp,b_base)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -2377,20 +2392,20 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aa = list_val(atmp);
- bb = list_val(btmp);
+ aa = list_val_rel(atmp,a_base);
+ bb = list_val_rel(btmp,b_base);
}
case TAG_PRIMARY_BOXED:
{
- Eterm ahdr = *boxed_val(a);
+ Eterm ahdr = *boxed_val_rel(a,a_base);
switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
- if (is_not_tuple(b)) {
+ if (!is_tuple_rel(b,b_base)) {
a_tag = TUPLE_DEF;
goto mixed_types;
}
- aa = tuple_val(a);
- bb = tuple_val(b);
+ aa = tuple_val_rel(a,a_base);
+ bb = tuple_val_rel(b,b_base);
/* compare the arities */
i = arityval(ahdr); /* get the arity*/
if (i != arityval(*bb)) {
@@ -2404,31 +2419,31 @@ tailrecur_ne:
goto term_array;
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (is_not_float(b)) {
+ if (!is_float_rel(b,b_base)) {
a_tag = FLOAT_DEF;
goto mixed_types;
} else {
FloatDef af;
FloatDef bf;
- GET_DOUBLE(a, af);
- GET_DOUBLE(b, bf);
+ GET_DOUBLE_REL(a, af, a_base);
+ GET_DOUBLE_REL(b, bf, b_base);
ON_CMP_GOTO(float_comp(af.fd, bf.fd));
}
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (is_not_big(b)) {
+ if (!is_big_rel(b,b_base)) {
a_tag = BIG_DEF;
goto mixed_types;
}
- ON_CMP_GOTO(big_comp(a, b));
+ ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base)));
case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
- if (is_not_export(b)) {
+ if (!is_export_rel(b,b_base)) {
a_tag = EXPORT_DEF;
goto mixed_types;
} else {
- Export* a_exp = *((Export **) (export_val(a) + 1));
- Export* b_exp = *((Export **) (export_val(b) + 1));
+ Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
+ Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
RETURN_NEQ(j);
@@ -2440,12 +2455,12 @@ tailrecur_ne:
}
break;
case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
- if (is_not_fun(b)) {
+ if (!is_fun_rel(b,b_base)) {
a_tag = FUN_DEF;
goto mixed_types;
} else {
- ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
- ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
+ ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base);
+ ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base);
Sint diff;
diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name,
@@ -2477,51 +2492,57 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid(b)) {
- bnode = external_pid_node(b);
- bdata = external_pid_data(b);
+ } else if (is_external_pid_rel(b,b_base)) {
+ bnode = external_pid_node_rel(b,b_base);
+ bdata = external_pid_data_rel(b,b_base);
} else {
a_tag = EXTERNAL_PID_DEF;
goto mixed_types;
}
- anode = external_pid_node(a);
- adata = external_pid_data(a);
+ anode = external_pid_node_rel(a,a_base);
+ adata = external_pid_data_rel(a,a_base);
goto pid_common;
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE):
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port(b)) {
- bnode = external_port_node(b);
- bdata = external_port_data(b);
+ } else if (is_external_port_rel(b,b_base)) {
+ bnode = external_port_node_rel(b,b_base);
+ bdata = external_port_data_rel(b,b_base);
} else {
a_tag = EXTERNAL_PORT_DEF;
goto mixed_types;
}
- anode = external_port_node(a);
- adata = external_port_data(a);
+ anode = external_port_node_rel(a,a_base);
+ adata = external_port_data_rel(a,a_base);
goto port_common;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
/*
* Note! When comparing refs we need to compare ref numbers
* (32-bit words), *not* ref data words.
*/
+
- if (is_internal_ref(b)) {
+ if (is_internal_ref_rel(b,b_base)) {
+ RefThing* bthing = ref_thing_ptr_rel(b,b_base);
bnode = erts_this_node;
- bnum = internal_ref_numbers(b);
- blen = internal_ref_no_of_numbers(b);
- } else if(is_external_ref(b)) {
- bnode = external_ref_node(b);
- bnum = external_ref_numbers(b);
- blen = external_ref_no_of_numbers(b);
+ bnum = internal_thing_ref_numbers(bthing);
+ blen = internal_thing_ref_no_of_numbers(bthing);
+ } else if(is_external_ref_rel(b,b_base)) {
+ ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ bnode = bthing->node;
+ bnum = external_thing_ref_numbers(bthing);
+ blen = external_thing_ref_no_of_numbers(bthing);
} else {
a_tag = REF_DEF;
goto mixed_types;
}
- anode = erts_this_node;
- anum = internal_ref_numbers(a);
- alen = internal_ref_no_of_numbers(a);
+ {
+ RefThing* athing = ref_thing_ptr_rel(a,a_base);
+ anode = erts_this_node;
+ anum = internal_thing_ref_numbers(athing);
+ alen = internal_thing_ref_no_of_numbers(athing);
+ }
ref_common:
CMP_NODES(anode, bnode);
@@ -2550,31 +2571,36 @@ tailrecur_ne:
RETURN_NEQ((Sint32) (anum[i] - bnum[i]));
goto pop_next;
case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE):
- if (is_internal_ref(b)) {
+ if (is_internal_ref_rel(b,b_base)) {
+ RefThing* bthing = ref_thing_ptr_rel(b,b_base);
bnode = erts_this_node;
- bnum = internal_ref_numbers(b);
- blen = internal_ref_no_of_numbers(b);
- } else if (is_external_ref(b)) {
- bnode = external_ref_node(b);
- bnum = external_ref_numbers(b);
- blen = external_ref_no_of_numbers(b);
+ bnum = internal_thing_ref_numbers(bthing);
+ blen = internal_thing_ref_no_of_numbers(bthing);
+ } else if (is_external_ref_rel(b,b_base)) {
+ ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ bnode = bthing->node;
+ bnum = external_thing_ref_numbers(bthing);
+ blen = external_thing_ref_no_of_numbers(bthing);
} else {
a_tag = EXTERNAL_REF_DEF;
goto mixed_types;
}
- anode = external_ref_node(a);
- anum = external_ref_numbers(a);
- alen = external_ref_no_of_numbers(a);
+ {
+ ExternalThing* athing = external_thing_ptr_rel(a,a_base);
+ anode = athing->node;
+ anum = external_thing_ref_numbers(athing);
+ alen = external_thing_ref_no_of_numbers(athing);
+ }
goto ref_common;
default:
/* Must be a binary */
- ASSERT(is_binary(a));
- if (is_not_binary(b)) {
+ ASSERT(is_binary_rel(a,a_base));
+ if (!is_binary_rel(b,b_base)) {
a_tag = BINARY_DEF;
goto mixed_types;
} else {
- Uint a_size = binary_size(a);
- Uint b_size = binary_size(b);
+ Uint a_size = binary_size_rel(a,a_base);
+ Uint b_size = binary_size_rel(b,b_base);
Uint a_bitsize;
Uint b_bitsize;
Uint a_bitoffs;
@@ -2583,8 +2609,8 @@ tailrecur_ne:
int cmp;
byte* a_ptr;
byte* b_ptr;
- ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
- ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
+ ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
+ ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
min_size = (a_size < b_size) ? a_size : b_size;
if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
@@ -2611,7 +2637,6 @@ tailrecur_ne:
*/
mixed_types:
- b_tag = tag_val_def(b);
{
FloatDef f1, f2;
@@ -2621,39 +2646,47 @@ tailrecur_ne:
#else
Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap;
#endif
+#if HALFWORD_HEAP
+ Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base);
+ Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base);
+#else
+ Eterm aw = a;
+ Eterm bw = b;
+#endif
+ b_tag = tag_val_def(bw);
switch(_NUMBER_CODE(a_tag, b_tag)) {
case SMALL_BIG:
big = small_to_big(signed_val(a), big_buf);
- j = big_comp(big, b);
+ j = big_comp(big, bw);
break;
case SMALL_FLOAT:
f1.fd = signed_val(a);
- GET_DOUBLE(b, f2);
+ GET_DOUBLE(bw, f2);
j = float_comp(f1.fd, f2.fd);
break;
case BIG_SMALL:
big = small_to_big(signed_val(b), big_buf);
- j = big_comp(a, big);
+ j = big_comp(aw, big);
break;
case BIG_FLOAT:
- if (big_to_double(a, &f1.fd) < 0) {
+ if (big_to_double(aw, &f1.fd) < 0) {
j = big_sign(a) ? -1 : 1;
} else {
- GET_DOUBLE(b, f2);
+ GET_DOUBLE(bw, f2);
j = float_comp(f1.fd, f2.fd);
}
break;
case FLOAT_SMALL:
- GET_DOUBLE(a, f1);
+ GET_DOUBLE(aw, f1);
f2.fd = signed_val(b);
j = float_comp(f1.fd, f2.fd);
break;
case FLOAT_BIG:
- if (big_to_double(b, &f2.fd) < 0) {
+ if (big_to_double(bw, &f2.fd) < 0) {
j = big_sign(b) ? 1 : -1;
} else {
- GET_DOUBLE(a, f1);
+ GET_DOUBLE(aw, f1);
j = float_comp(f1.fd, f2.fd);
}
break;
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 010d60eb63..8421eb415c 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -77,8 +77,10 @@ static int atoms_initialized;
static Uint cache_check_interval;
+typedef struct mem_kind_t MemKind;
+
static void check_cache(void *unused);
-static void mseg_clear_cache(void);
+static void mseg_clear_cache(MemKind*);
static int is_cache_check_scheduled;
#ifdef ERTS_THREADS_NO_SMP
static int is_cache_check_requested;
@@ -160,14 +162,43 @@ static struct {
CallCounter check_cache;
} calls;
-static cache_desc_t cache_descs[MAX_CACHE_SIZE];
-static cache_desc_t *free_cache_descs;
-static cache_desc_t *cache;
-static cache_desc_t *cache_end;
-static Uint cache_hits;
-static Uint cache_size;
-static Uint min_cached_seg_size;
-static Uint max_cached_seg_size;
+struct mem_kind_t {
+ cache_desc_t cache_descs[MAX_CACHE_SIZE];
+ cache_desc_t *free_cache_descs;
+ cache_desc_t *cache;
+ cache_desc_t *cache_end;
+
+ Uint cache_size;
+ Uint min_cached_seg_size;
+ Uint max_cached_seg_size;
+ Uint cache_hits;
+
+ struct {
+ struct {
+ Uint watermark;
+ Uint no;
+ Uint sz;
+ } current;
+ struct {
+ Uint no;
+ Uint sz;
+ } max;
+ struct {
+ Uint no;
+ Uint sz;
+ } max_ever;
+ } segments;
+
+ const char* name;
+ MemKind* next;
+};/*MemKind*/
+
+#if HALFWORD_HEAP
+static MemKind low_mem, hi_mem;
+#else
+static MemKind the_mem;
+#endif
+static MemKind* mk_list = NULL;
static Uint max_cache_size;
static Uint abs_max_cache_bad_fit;
@@ -177,47 +208,32 @@ static Uint rel_max_cache_bad_fit;
static Uint min_seg_size;
#endif
-struct {
- struct {
- Uint watermark;
- Uint no;
- Uint sz;
- } current;
- struct {
- Uint no;
- Uint sz;
- } max;
- struct {
- Uint no;
- Uint sz;
- } max_ever;
-} segments;
-#define ERTS_MSEG_ALLOC_STAT(SZ) \
+#define ERTS_MSEG_ALLOC_STAT(C,SZ) \
do { \
- segments.current.no++; \
- if (segments.max.no < segments.current.no) \
- segments.max.no = segments.current.no; \
- if (segments.current.watermark < segments.current.no) \
- segments.current.watermark = segments.current.no; \
- segments.current.sz += (SZ); \
- if (segments.max.sz < segments.current.sz) \
- segments.max.sz = segments.current.sz; \
+ C->segments.current.no++; \
+ if (C->segments.max.no < C->segments.current.no) \
+ C->segments.max.no = C->segments.current.no; \
+ if (C->segments.current.watermark < C->segments.current.no) \
+ C->segments.current.watermark = C->segments.current.no; \
+ C->segments.current.sz += (SZ); \
+ if (C->segments.max.sz < C->segments.current.sz) \
+ C->segments.max.sz = C->segments.current.sz; \
} while (0)
-#define ERTS_MSEG_DEALLOC_STAT(SZ) \
+#define ERTS_MSEG_DEALLOC_STAT(C,SZ) \
do { \
- ASSERT(segments.current.no > 0); \
- segments.current.no--; \
- ASSERT(segments.current.sz >= (SZ)); \
- segments.current.sz -= (SZ); \
+ ASSERT(C->segments.current.no > 0); \
+ C->segments.current.no--; \
+ ASSERT(C->segments.current.sz >= (SZ)); \
+ C->segments.current.sz -= (SZ); \
} while (0)
-#define ERTS_MSEG_REALLOC_STAT(OSZ, NSZ) \
+#define ERTS_MSEG_REALLOC_STAT(C,OSZ, NSZ) \
do { \
- ASSERT(segments.current.sz >= (OSZ)); \
- segments.current.sz -= (OSZ); \
- segments.current.sz += (NSZ); \
+ ASSERT(C->segments.current.sz >= (OSZ)); \
+ C->segments.current.sz -= (OSZ); \
+ C->segments.current.sz += (NSZ); \
} while (0)
#define ONE_GIGA (1000000000)
@@ -303,13 +319,16 @@ check_schedule_cache_check(void)
static void
mseg_shutdown(void)
{
+ MemKind* mk;
erts_mtx_lock(&mseg_mutex);
- mseg_clear_cache();
+ for (mk=mk_list; mk; mk=mk->next) {
+ mseg_clear_cache(mk);
+ }
erts_mtx_unlock(&mseg_mutex);
}
static ERTS_INLINE void *
-mseg_create(Uint size)
+mseg_create(MemKind* mk, Uint size)
{
void *seg;
@@ -319,19 +338,21 @@ mseg_create(Uint size)
seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size);
#elif HAVE_MMAP
#if HALFWORD_HEAP
- seg = pmmap(size);
-#else
- seg = (void *) mmap((void *) 0, (size_t) size,
- MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0);
- if (seg == (void *) MAP_FAILED)
- seg = NULL;
-#endif
-#if HALFWORD_HEAP
- if ((unsigned long) seg & CHECK_POINTER_MASK) {
- erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg);
- return NULL;
+ if (mk == &low_mem) {
+ seg = pmmap(size);
+ if ((unsigned long) seg & CHECK_POINTER_MASK) {
+ erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg);
+ return NULL;
+ }
}
+ else
#endif
+ {
+ seg = (void *) mmap((void *) 0, (size_t) size,
+ MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0);
+ if (seg == (void *) MAP_FAILED)
+ seg = NULL;
+ }
#else
#error "Missing mseg_create() implementation"
#endif
@@ -342,20 +363,23 @@ mseg_create(Uint size)
}
static ERTS_INLINE void
-mseg_destroy(void *seg, Uint size)
+mseg_destroy(MemKind* mk, void *seg, Uint size)
{
#if defined(ERTS_MSEG_FAKE_SEGMENTS)
erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg);
#elif HAVE_MMAP
+ int res;
-#ifdef DEBUG
- int res =
-#endif
#if HALFWORD_HEAP
- pmunmap((void *) seg, size);
-#else
- munmap((void *) seg, size);
+ if (mk == &low_mem) {
+ res = pmunmap((void *) seg, size);
+ }
+ else
#endif
+ {
+ res = munmap((void *) seg, size);
+ }
+
ASSERT(size % page_size == 0);
ASSERT(res == 0);
#else
@@ -369,7 +393,7 @@ mseg_destroy(void *seg, Uint size)
#if HAVE_MSEG_RECREATE
static ERTS_INLINE void *
-mseg_recreate(void *old_seg, Uint old_size, Uint new_size)
+mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
{
void *new_seg;
@@ -380,25 +404,29 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size)
new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size);
#elif HAVE_MREMAP
#if HALFWORD_HEAP
- new_seg = (void *) pmremap((void *) old_seg,
- (size_t) old_size,
- (size_t) new_size);
-#elif defined(__NetBSD__)
- new_seg = (void *) mremap((void *) old_seg,
- (size_t) old_size,
- NULL,
- (size_t) new_size,
- 0);
- if (new_seg == (void *) MAP_FAILED)
- new_seg = NULL;
-#else
- new_seg = (void *) mremap((void *) old_seg,
- (size_t) old_size,
- (size_t) new_size,
- MREMAP_MAYMOVE);
- if (new_seg == (void *) MAP_FAILED)
- new_seg = NULL;
+ if (mk == &low_mem) {
+ new_seg = (void *) pmremap((void *) old_seg,
+ (size_t) old_size,
+ (size_t) new_size);
+ }
+ else
#endif
+ {
+ #if defined(__NetBSD__)
+ new_seg = (void *) mremap((void *) old_seg,
+ (size_t) old_size,
+ NULL,
+ (size_t) new_size,
+ 0);
+ #else
+ new_seg = (void *) mremap((void *) old_seg,
+ (size_t) old_size,
+ (size_t) new_size,
+ MREMAP_MAYMOVE);
+ #endif
+ if (new_seg == (void *) MAP_FAILED)
+ new_seg = NULL;
+ }
#else
#error "Missing mseg_recreate() implementation"
#endif
@@ -412,134 +440,142 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size)
static ERTS_INLINE cache_desc_t *
-alloc_cd(void)
+alloc_cd(MemKind* mk)
{
- cache_desc_t *cd = free_cache_descs;
+ cache_desc_t *cd = mk->free_cache_descs;
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
if (cd)
- free_cache_descs = cd->next;
+ mk->free_cache_descs = cd->next;
return cd;
}
static ERTS_INLINE void
-free_cd(cache_desc_t *cd)
+free_cd(MemKind* mk, cache_desc_t *cd)
{
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
- cd->next = free_cache_descs;
- free_cache_descs = cd;
+ cd->next = mk->free_cache_descs;
+ mk->free_cache_descs = cd;
}
static ERTS_INLINE void
-link_cd(cache_desc_t *cd)
+link_cd(MemKind* mk, cache_desc_t *cd)
{
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
- if (cache)
- cache->prev = cd;
- cd->next = cache;
+ if (mk->cache)
+ mk->cache->prev = cd;
+ cd->next = mk->cache;
cd->prev = NULL;
- cache = cd;
+ mk->cache = cd;
- if (!cache_end) {
+ if (!mk->cache_end) {
ASSERT(!cd->next);
- cache_end = cd;
+ mk->cache_end = cd;
}
- cache_size++;
+ mk->cache_size++;
}
+#if CAN_PARTLY_DESTROY
static ERTS_INLINE void
-end_link_cd(cache_desc_t *cd)
+end_link_cd(MemKind* mk, cache_desc_t *cd)
{
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
- if (cache_end)
- cache_end->next = cd;
+ if (mk->cache_end)
+ mk->cache_end->next = cd;
cd->next = NULL;
- cd->prev = cache_end;
- cache_end = cd;
+ cd->prev = mk->cache_end;
+ mk->cache_end = cd;
- if (!cache) {
+ if (!mk->cache) {
ASSERT(!cd->prev);
- cache = cd;
+ mk->cache = cd;
}
- cache_size++;
+ mk->cache_size++;
}
+#endif
static ERTS_INLINE void
-unlink_cd(cache_desc_t *cd)
+unlink_cd(MemKind* mk, cache_desc_t *cd)
{
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
if (cd->next)
cd->next->prev = cd->prev;
else
- cache_end = cd->prev;
+ mk->cache_end = cd->prev;
if (cd->prev)
cd->prev->next = cd->next;
else
- cache = cd->next;
- ASSERT(cache_size > 0);
- cache_size--;
+ mk->cache = cd->next;
+ ASSERT(mk->cache_size > 0);
+ mk->cache_size--;
}
static ERTS_INLINE void
-check_cache_limits(void)
+check_cache_limits(MemKind* mk)
{
cache_desc_t *cd;
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
- max_cached_seg_size = 0;
- min_cached_seg_size = ~((Uint) 0);
- for (cd = cache; cd; cd = cd->next) {
- if (cd->size < min_cached_seg_size)
- min_cached_seg_size = cd->size;
- if (cd->size > max_cached_seg_size)
- max_cached_seg_size = cd->size;
+ mk->max_cached_seg_size = 0;
+ mk->min_cached_seg_size = ~((Uint) 0);
+ for (cd = mk->cache; cd; cd = cd->next) {
+ if (cd->size < mk->min_cached_seg_size)
+ mk->min_cached_seg_size = cd->size;
+ if (cd->size > mk->max_cached_seg_size)
+ mk->max_cached_seg_size = cd->size;
}
-
}
static ERTS_INLINE void
-adjust_cache_size(int force_check_limits)
+adjust_cache_size(MemKind* mk, int force_check_limits)
{
cache_desc_t *cd;
int check_limits = force_check_limits;
- Sint max_cached = ((Sint) segments.current.watermark
- - (Sint) segments.current.no);
+ Sint max_cached = ((Sint) mk->segments.current.watermark
+ - (Sint) mk->segments.current.no);
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
- while (((Sint) cache_size) > max_cached && ((Sint) cache_size) > 0) {
- ASSERT(cache_end);
- cd = cache_end;
+ while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) {
+ ASSERT(mk->cache_end);
+ cd = mk->cache_end;
if (!check_limits &&
- !(min_cached_seg_size < cd->size
- && cd->size < max_cached_seg_size)) {
+ !(mk->min_cached_seg_size < cd->size
+ && cd->size < mk->max_cached_seg_size)) {
check_limits = 1;
}
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg);
- mseg_destroy(cd->seg, cd->size);
- unlink_cd(cd);
- free_cd(cd);
+ mseg_destroy(mk, cd->seg, cd->size);
+ unlink_cd(mk,cd);
+ free_cd(mk,cd);
}
if (check_limits)
- check_cache_limits();
-
+ check_cache_limits(mk);
}
static void
-check_cache(void *unused)
+check_one_cache(MemKind* mk)
{
+ if (mk->segments.current.watermark > mk->segments.current.no)
+ mk->segments.current.watermark--;
+ adjust_cache_size(mk, 0);
+
+ if (mk->cache_size)
+ schedule_cache_check();
+}
+
+static void check_cache(void* unused)
+{
+ MemKind* mk;
erts_mtx_lock(&mseg_mutex);
is_cache_check_scheduled = 0;
- if (segments.current.watermark > segments.current.no)
- segments.current.watermark--;
- adjust_cache_size(0);
-
- if (cache_size)
- schedule_cache_check();
+ for (mk=mk_list; mk; mk=mk->next) {
+ check_one_cache(mk);
+ }
INC_CC(check_cache);
@@ -547,28 +583,45 @@ check_cache(void *unused)
}
static void
-mseg_clear_cache(void)
+mseg_clear_cache(MemKind* mk)
{
- segments.current.watermark = 0;
+ mk->segments.current.watermark = 0;
- adjust_cache_size(1);
+ adjust_cache_size(mk, 1);
- ASSERT(!cache);
- ASSERT(!cache_end);
- ASSERT(!cache_size);
+ ASSERT(!mk->cache);
+ ASSERT(!mk->cache_end);
+ ASSERT(!mk->cache_size);
- segments.current.watermark = segments.current.no;
+ mk->segments.current.watermark = mk->segments.current.no;
INC_CC(clear_cache);
}
+static ERTS_INLINE MemKind* type2mk(ErtsAlcType_t atype)
+{
+#if HALFWORD_HEAP
+ switch (atype) {
+ case ERTS_ALC_A_ETS:
+ case ERTS_ALC_A_BINARY:
+ case ERTS_ALC_A_FIXED_SIZE:
+ case ERTS_ALC_A_DRIVER:
+ return &hi_mem;
+ default:
+ return &low_mem;
+ }
+#else
+ return &the_mem;
+#endif
+}
+
static void *
mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
{
-
Uint max, min, diff_size, size;
cache_desc_t *cd, *cand_cd;
void *seg;
+ MemKind* mk = type2mk(atype);
INC_CC(alloc);
@@ -581,11 +634,11 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
if (!opt->cache) {
create_seg:
- adjust_cache_size(0);
- seg = mseg_create(size);
+ adjust_cache_size(mk,0);
+ seg = mseg_create(mk, size);
if (!seg) {
- mseg_clear_cache();
- seg = mseg_create(size);
+ mseg_clear_cache(mk);
+ seg = mseg_create(mk, size);
if (!seg)
size = 0;
}
@@ -594,17 +647,17 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
if (seg) {
if (erts_mtrace_enabled)
erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size);
- ERTS_MSEG_ALLOC_STAT(size);
+ ERTS_MSEG_ALLOC_STAT(mk,size);
}
return seg;
}
- if (size > max_cached_seg_size)
+ if (size > mk->max_cached_seg_size)
goto create_seg;
- if (size < min_cached_seg_size) {
+ if (size < mk->min_cached_seg_size) {
- diff_size = min_cached_seg_size - size;
+ diff_size = mk->min_cached_seg_size - size;
if (diff_size > abs_max_cache_bad_fit)
goto create_seg;
@@ -618,7 +671,7 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
min = ~((Uint) 0);
cand_cd = NULL;
- for (cd = cache; cd; cd = cd->next) {
+ for (cd = mk->cache; cd; cd = cd->next) {
if (cd->size >= size) {
if (!cand_cd) {
cand_cd = cd;
@@ -639,8 +692,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
min = cd->size;
}
- min_cached_seg_size = min;
- max_cached_seg_size = max;
+ mk->min_cached_seg_size = min;
+ mk->max_cached_seg_size = max;
if (!cand_cd)
goto create_seg;
@@ -649,20 +702,20 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
if (diff_size > abs_max_cache_bad_fit
|| 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) {
- if (max_cached_seg_size < cand_cd->size)
- max_cached_seg_size = cand_cd->size;
- if (min_cached_seg_size > cand_cd->size)
- min_cached_seg_size = cand_cd->size;
+ if (mk->max_cached_seg_size < cand_cd->size)
+ mk->max_cached_seg_size = cand_cd->size;
+ if (mk->min_cached_seg_size > cand_cd->size)
+ mk->min_cached_seg_size = cand_cd->size;
goto create_seg;
}
- cache_hits++;
+ mk->cache_hits++;
size = cand_cd->size;
seg = cand_cd->seg;
- unlink_cd(cand_cd);
- free_cd(cand_cd);
+ unlink_cd(mk,cand_cd);
+ free_cd(mk,cand_cd);
*size_p = size;
@@ -672,7 +725,7 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
}
if (seg)
- ERTS_MSEG_ALLOC_STAT(size);
+ ERTS_MSEG_ALLOC_STAT(mk,size);
return seg;
}
@@ -681,41 +734,42 @@ static void
mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size,
const ErtsMsegOpt_t *opt)
{
+ MemKind* mk = type2mk(atype);
cache_desc_t *cd;
- ERTS_MSEG_DEALLOC_STAT(size);
+ ERTS_MSEG_DEALLOC_STAT(mk,size);
if (!opt->cache || max_cache_size == 0) {
if (erts_mtrace_enabled)
erts_mtrace_crr_free(atype, SEGTYPE, seg);
- mseg_destroy(seg, size);
+ mseg_destroy(mk, seg, size);
}
else {
int check_limits = 0;
- if (size < min_cached_seg_size)
- min_cached_seg_size = size;
- if (size > max_cached_seg_size)
- max_cached_seg_size = size;
-
- if (!free_cache_descs) {
- cd = cache_end;
- if (!(min_cached_seg_size < cd->size
- && cd->size < max_cached_seg_size)) {
+ if (size < mk->min_cached_seg_size)
+ mk->min_cached_seg_size = size;
+ if (size > mk->max_cached_seg_size)
+ mk->max_cached_seg_size = size;
+
+ if (!mk->free_cache_descs) {
+ cd = mk->cache_end;
+ if (!(mk->min_cached_seg_size < cd->size
+ && cd->size < mk->max_cached_seg_size)) {
check_limits = 1;
}
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg);
- mseg_destroy(cd->seg, cd->size);
- unlink_cd(cd);
- free_cd(cd);
+ mseg_destroy(mk, cd->seg, cd->size);
+ unlink_cd(mk,cd);
+ free_cd(mk,cd);
}
- cd = alloc_cd();
+ cd = alloc_cd(mk);
ASSERT(cd);
cd->seg = seg;
cd->size = size;
- link_cd(cd);
+ link_cd(mk,cd);
if (erts_mtrace_enabled) {
erts_mtrace_crr_free(atype, SEGTYPE, seg);
@@ -725,7 +779,7 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size,
/* ASSERT(segments.current.watermark >= segments.current.no + cache_size); */
if (check_limits)
- check_cache_limits();
+ check_cache_limits(mk);
schedule_cache_check();
@@ -738,6 +792,7 @@ static void *
mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
const ErtsMsegOpt_t *opt)
{
+ MemKind* mk = type2mk(atype);
void *new_seg;
Uint new_size;
@@ -775,15 +830,15 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
#if CAN_PARTLY_DESTROY
if (shrink_sz > min_seg_size
- && free_cache_descs
+ && mk->free_cache_descs
&& opt->cache) {
cache_desc_t *cd;
- cd = alloc_cd();
+ cd = alloc_cd(mk);
ASSERT(cd);
cd->seg = ((char *) seg) + new_size;
cd->size = shrink_sz;
- end_link_cd(cd);
+ end_link_cd(mk,cd);
if (erts_mtrace_enabled) {
erts_mtrace_crr_realloc(new_seg,
@@ -802,7 +857,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
SEGTYPE,
seg,
new_size);
- mseg_destroy(((char *) seg) + new_size, shrink_sz);
+ mseg_destroy(mk, ((char *) seg) + new_size, shrink_sz);
}
#elif HAVE_MSEG_RECREATE
@@ -836,7 +891,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
#if !CAN_PARTLY_DESTROY
do_recreate:
#endif
- new_seg = mseg_recreate((void *) seg, old_size, new_size);
+ new_seg = mseg_recreate(mk, (void *) seg, old_size, new_size);
if (erts_mtrace_enabled)
erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size);
if (!new_seg)
@@ -859,7 +914,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
*new_size_p = new_size;
- ERTS_MSEG_REALLOC_STAT(old_size, new_size);
+ ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size);
return new_seg;
}
@@ -875,6 +930,8 @@ static struct {
Eterm mcs;
Eterm cci;
+ Eterm memkind;
+ Eterm name;
Eterm status;
Eterm cached_segments;
Eterm cache_hits;
@@ -924,6 +981,8 @@ init_atoms(void)
#endif
AM_INIT(version);
+ AM_INIT(memkind);
+ AM_INIT(name);
AM_INIT(options);
AM_INIT(amcbf);
@@ -1134,65 +1193,88 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
}
static Eterm
-info_status(int *print_to_p,
- void *print_to_arg,
- int begin_new_max_period,
- Uint **hpp,
- Uint *szp)
+info_status(MemKind* mk, int *print_to_p, void *print_to_arg,
+ int begin_new_max_period, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
- if (segments.max_ever.no < segments.max.no)
- segments.max_ever.no = segments.max.no;
- if (segments.max_ever.sz < segments.max.sz)
- segments.max_ever.sz = segments.max.sz;
+ if (mk->segments.max_ever.no < mk->segments.max.no)
+ mk->segments.max_ever.no = mk->segments.max.no;
+ if (mk->segments.max_ever.sz < mk->segments.max.sz)
+ mk->segments.max_ever.sz = mk->segments.max.sz;
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "cached_segments: %bpu\n", cache_size);
- erts_print(to, arg, "cache_hits: %bpu\n", cache_hits);
+ erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size);
+ erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits);
erts_print(to, arg, "segments: %bpu %bpu %bpu\n",
- segments.current.no, segments.max.no, segments.max_ever.no);
+ mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no);
erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n",
- segments.current.sz, segments.max.sz, segments.max_ever.sz);
+ mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz);
erts_print(to, arg, "segments_watermark: %bpu\n",
- segments.current.watermark);
+ mk->segments.current.watermark);
}
if (hpp || szp) {
res = NIL;
add_2tup(hpp, szp, &res,
am.segments_watermark,
- bld_unstable_uint(hpp, szp, segments.current.watermark));
+ bld_unstable_uint(hpp, szp, mk->segments.current.watermark));
add_4tup(hpp, szp, &res,
am.segments_size,
- bld_unstable_uint(hpp, szp, segments.current.sz),
- bld_unstable_uint(hpp, szp, segments.max.sz),
- bld_unstable_uint(hpp, szp, segments.max_ever.sz));
+ bld_unstable_uint(hpp, szp, mk->segments.current.sz),
+ bld_unstable_uint(hpp, szp, mk->segments.max.sz),
+ bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz));
add_4tup(hpp, szp, &res,
am.segments,
- bld_unstable_uint(hpp, szp, segments.current.no),
- bld_unstable_uint(hpp, szp, segments.max.no),
- bld_unstable_uint(hpp, szp, segments.max_ever.no));
+ bld_unstable_uint(hpp, szp, mk->segments.current.no),
+ bld_unstable_uint(hpp, szp, mk->segments.max.no),
+ bld_unstable_uint(hpp, szp, mk->segments.max_ever.no));
add_2tup(hpp, szp, &res,
am.cache_hits,
- bld_unstable_uint(hpp, szp, cache_hits));
+ bld_unstable_uint(hpp, szp, mk->cache_hits));
add_2tup(hpp, szp, &res,
am.cached_segments,
- bld_unstable_uint(hpp, szp, cache_size));
+ bld_unstable_uint(hpp, szp, mk->cache_size));
}
if (begin_new_max_period) {
- segments.max.no = segments.current.no;
- segments.max.sz = segments.current.sz;
+ mk->segments.max.no = mk->segments.current.no;
+ mk->segments.max.sz = mk->segments.current.sz;
}
return res;
}
+static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg,
+ int begin_max_per, Uint **hpp, Uint *szp)
+{
+ Eterm res = THE_NON_VALUE;
+ Eterm atoms[3];
+ Eterm values[3];
+
+ if (print_to_p) {
+ erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name);
+ }
+ if (hpp || szp) {
+ atoms[0] = am.name;
+ atoms[1] = am.status;
+ atoms[2] = am.calls;
+ values[0] = erts_bld_string(hpp, szp, mk->name);
+ }
+ values[1] = info_status(mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[2] = info_calls(print_to_p, print_to_arg, hpp, szp);
+
+ if (hpp || szp)
+ res = bld_2tup_list(hpp, szp, 3, atoms, values);
+
+ return res;
+}
+
+
static Eterm
info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
@@ -1239,6 +1321,7 @@ erts_mseg_info(int *print_to_p,
Eterm res = THE_NON_VALUE;
Eterm atoms[4];
Eterm values[4];
+ Uint n = 0;
erts_mtx_lock(&mseg_mutex);
@@ -1249,17 +1332,19 @@ erts_mseg_info(int *print_to_p,
atoms[0] = am.version;
atoms[1] = am.options;
- atoms[2] = am.status;
- atoms[3] = am.calls;
+ atoms[2] = am.memkind;
+ atoms[3] = am.memkind;
}
-
- values[0] = info_version(print_to_p, print_to_arg, hpp, szp);
- values[1] = info_options("option ", print_to_p, print_to_arg, hpp, szp);
- values[2] = info_status(print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[3] = info_calls(print_to_p, print_to_arg, hpp, szp);
-
+ values[n++] = info_version(print_to_p, print_to_arg, hpp, szp);
+ values[n++] = info_options("option ", print_to_p, print_to_arg, hpp, szp);
+#if HALFWORD_HEAP
+ values[n++] = info_memkind(&low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[n++] = info_memkind(&hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+#else
+ values[n++] = info_memkind(&the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+#endif
if (hpp || szp)
- res = bld_2tup_list(hpp, szp, 4, atoms, values);
+ res = bld_2tup_list(hpp, szp, n, atoms, values);
erts_mtx_unlock(&mseg_mutex);
@@ -1318,17 +1403,23 @@ erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size,
void
erts_mseg_clear_cache(void)
{
+ MemKind* mk;
erts_mtx_lock(&mseg_mutex);
- mseg_clear_cache();
+ for (mk=mk_list; mk; mk=mk->next) {
+ mseg_clear_cache(mk);
+ }
erts_mtx_unlock(&mseg_mutex);
}
Uint
erts_mseg_no(void)
{
- Uint n;
+ MemKind* mk;
+ Uint n = 0;
erts_mtx_lock(&mseg_mutex);
- n = segments.current.no;
+ for (mk=mk_list; mk; mk=mk->next) {
+ n += mk->segments.current.no;
+ }
erts_mtx_unlock(&mseg_mutex);
return n;
}
@@ -1339,11 +1430,43 @@ erts_mseg_unit_size(void)
return page_size;
}
-void
-erts_mseg_init(ErtsMsegInit_t *init)
+static void mem_kind_init(MemKind* mk, const char* name)
{
unsigned i;
+ mk->cache = NULL;
+ mk->cache_end = NULL;
+ mk->max_cached_seg_size = 0;
+ mk->min_cached_seg_size = ~((Uint) 0);
+ mk->cache_size = 0;
+ mk->cache_hits = 0;
+
+ if (max_cache_size > 0) {
+ for (i = 0; i < max_cache_size - 1; i++)
+ mk->cache_descs[i].next = &mk->cache_descs[i + 1];
+ mk->cache_descs[max_cache_size - 1].next = NULL;
+ mk->free_cache_descs = &mk->cache_descs[0];
+ }
+ else
+ mk->free_cache_descs = NULL;
+
+ mk->segments.current.watermark = 0;
+ mk->segments.current.no = 0;
+ mk->segments.current.sz = 0;
+ mk->segments.max.no = 0;
+ mk->segments.max.sz = 0;
+ mk->segments.max_ever.no = 0;
+ mk->segments.max_ever.sz = 0;
+
+ mk->name = name;
+ mk->next = mk_list;
+ mk_list = mk;
+}
+
+
+void
+erts_mseg_init(ErtsMsegInit_t *init)
+{
atoms_initialized = 0;
is_init_done = 0;
@@ -1386,40 +1509,33 @@ erts_mseg_init(ErtsMsegInit_t *init)
min_seg_size = ~((Uint) 0);
#endif
- cache = NULL;
- cache_end = NULL;
- cache_hits = 0;
- max_cached_seg_size = 0;
- min_cached_seg_size = ~((Uint) 0);
- cache_size = 0;
+ if (max_cache_size > MAX_CACHE_SIZE)
+ max_cache_size = MAX_CACHE_SIZE;
+
+#if HALFWORD_HEAP
+ mem_kind_init(&low_mem, "low memory");
+ mem_kind_init(&hi_mem, "high memory");
+#else
+ mem_kind_init(&the_mem, "all memory");
+#endif
is_cache_check_scheduled = 0;
#ifdef ERTS_THREADS_NO_SMP
is_cache_check_requested = 0;
#endif
+}
- if (max_cache_size > MAX_CACHE_SIZE)
- max_cache_size = MAX_CACHE_SIZE;
- if (max_cache_size > 0) {
- for (i = 0; i < max_cache_size - 1; i++)
- cache_descs[i].next = &cache_descs[i + 1];
- cache_descs[max_cache_size - 1].next = NULL;
- free_cache_descs = &cache_descs[0];
+static ERTS_INLINE Uint tot_cache_size(void)
+{
+ MemKind* mk;
+ Uint sz = 0;
+ for (mk=mk_list; mk; mk=mk->next) {
+ sz += mk->cache_size;
}
- else
- free_cache_descs = NULL;
-
- segments.current.watermark = 0;
- segments.current.no = 0;
- segments.current.sz = 0;
- segments.max.no = 0;
- segments.max.sz = 0;
- segments.max_ever.no = 0;
- segments.max_ever.sz = 0;
+ return sz;
}
-
/*
* erts_mseg_late_init() have to be called after all allocators,
* threads and timers have been initialized.
@@ -1437,7 +1553,7 @@ erts_mseg_late_init(void)
#ifdef ERTS_THREADS_NO_SMP
async_handle = handle;
#endif
- if (cache_size)
+ if (tot_cache_size())
schedule_cache_check();
erts_mtx_unlock(&mseg_mutex);
}
@@ -1478,7 +1594,7 @@ erts_mseg_test(unsigned long op,
case 0x406: {
unsigned long res;
erts_mtx_lock(&mseg_mutex);
- res = (unsigned long) cache_size;
+ res = (unsigned long) tot_cache_size();
erts_mtx_unlock(&mseg_mutex);
return res;
}
@@ -1757,6 +1873,7 @@ static int pmunmap(void *p, size_t size)
FreeBlock *last;
FreeBlock *nb = (FreeBlock *) p;
+ ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0);
if (real_size > pagsz) {
if (do_unmap(((char *) p) + pagsz,real_size - pagsz)) {
return 1;
diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c
index 6e9376b0f3..8ec7b31ce0 100644
--- a/erts/emulator/sys/unix/sys_float.c
+++ b/erts/emulator/sys/unix/sys_float.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -36,11 +36,6 @@ erts_sys_init_float(void)
# endif
}
-static ERTS_INLINE void set_current_fp_exception(unsigned long pc)
-{
- /* nothing to do */
-}
-
#else /* !NO_FPE_SIGNALS */
#ifdef ERTS_SMP
diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl
index e9d653a7c4..784869251a 100644
--- a/erts/emulator/test/a_SUITE.erl
+++ b/erts/emulator/test/a_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,15 +26,32 @@
%%%-------------------------------------------------------------------
-module(a_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, long_timers/1, pollset_size/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]).
-all(doc) ->
- [];
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[long_timers, pollset_size].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
long_timers(doc) ->
[];
long_timers(suite) ->
diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl
index 3e1a871408..78ac099792 100644
--- a/erts/emulator/test/after_SUITE.erl
+++ b/erts/emulator/test/after_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,27 +21,48 @@
%% Tests receive after.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, t_after/1, receive_after/1, receive_after_big/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ t_after/1, receive_after/1, receive_after_big/1,
receive_after_errors/1, receive_var_zero/1, receive_zero/1,
multi_timeout/1, receive_after_32bit/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
%% Internal exports.
-export([timeout_g/0]).
-all(suite) ->
- [t_after, receive_after, receive_after_big, receive_after_errors,
- receive_var_zero, receive_zero, multi_timeout, receive_after_32bit].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [t_after, receive_after, receive_after_big,
+ receive_after_errors, receive_var_zero, receive_zero,
+ multi_timeout, receive_after_32bit].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 94766dc6e9..687a4f0d5a 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,8 @@
-module(alloc_SUITE).
-author('[email protected]').
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([basic/1,
coalesce/1,
@@ -29,28 +30,40 @@
rbtree/1,
mseg_clear_cache/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(DEFAULT_TIMETRAP_SECS, 240).
-all(doc) -> [];
-all(suite) -> [basic,
- coalesce,
- threads,
- realloc_copy,
- bucket_index,
- bucket_mask,
- rbtree,
- mseg_clear_cache].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic, coalesce, threads, realloc_copy, bucket_index,
+ bucket_mask, rbtree, mseg_clear_cache].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)),
[{watchdog, Dog},{testcase, Case}|Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 32ac07cb2d..3643750883 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -19,17 +19,37 @@
-module(beam_SUITE).
--export([all/1, packed_registers/1, apply_last/1, apply_last_bif/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ packed_registers/1, apply_last/1, apply_last_bif/1,
buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1,
select_val/1]).
-export([applied/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [packed_registers, apply_last, apply_last_bif,
+ buildo_mucho, heap_sizes, big_lists, select_val].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [packed_registers, apply_last, apply_last_bif, buildo_mucho,
- heap_sizes, big_lists, select_val].
%% Verify that apply(M, F, A) is really tail recursive.
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 1eda939cf8..3ab7fc615b 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,8 @@
%%
-module(beam_literals_SUITE).
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([putting/1, matching_smalls/1, matching_smalls_jt/1,
matching_bigs/1, matching_more_bigs/1,
matching_bigs_and_smalls/1, badmatch/1, case_clause/1,
@@ -26,14 +27,32 @@
put_list/1, fconv/1, literal_case_expression/1,
increment/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[putting, matching_smalls, matching_smalls_jt,
matching_bigs, matching_more_bigs,
matching_bigs_and_smalls, badmatch, case_clause,
- receiving, literal_type_tests,
- put_list, fconv, literal_case_expression, increment].
+ receiving, literal_type_tests, put_list, fconv,
+ literal_case_expression, increment].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
putting(doc) -> "Test creating lists and tuples containing big number literals.";
putting(Config) when is_list(Config) ->
@@ -238,14 +257,14 @@ make_test([{T,L}|Ts]) ->
make_test([]) -> [].
test(T, L) ->
- S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])),
+ S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])),
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
{value,Val,_Bs} = erl_eval:exprs(E, []),
{match,0,{atom,0,Val},hd(E)}.
test(T, A, L) ->
- S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
+ S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
[T,L,A,T,L,A])),
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index b4ef0e6d5a..016befdced 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -19,24 +19,44 @@
-module(bif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
types/1,
t_list_to_existing_atom/1,os_env/1,otp_7526/1,
binary_to_atom/1,binary_to_existing_atom/1,
atom_to_binary/1,min_max/1]).
-all(suite) ->
- [types,t_list_to_existing_atom,os_env,otp_7526,
- atom_to_binary,binary_to_atom,binary_to_existing_atom,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [types, t_list_to_existing_atom, os_env, otp_7526,
+ atom_to_binary, binary_to_atom, binary_to_existing_atom,
min_max].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(1)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index 6cedd39009..60b19af68e 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,10 @@
-module(big_SUITE).
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1,
- borders/1, negative/1, big_float/1, big_float_1/1, big_float_2/1,
+ borders/1, negative/1, big_float_1/1, big_float_2/1,
shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]).
%% Internal exports.
@@ -30,19 +31,38 @@
-export([fac/1, fib/1, pow/2, gcd/2, lcm/2]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [t_div, eq_28, eq_32, eq_big, eq_math, big_literals,
+ borders, negative, {group, big_float}, shift_limit_1,
+ powmod, system_limit, otp_6692].
+
+groups() ->
+ [{big_float, [], [big_float_1, big_float_2]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders,
- negative, big_float, shift_limit_1, powmod, system_limit, otp_6692].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
@@ -260,10 +280,6 @@ big_literals(Config) when is_list(Config) ->
?line ok = Mod:t(),
ok.
-big_float(doc) ->
- ["Test cases for mixing bignums and floats"];
-big_float(suite) ->
- [big_float_1, big_float_2].
big_float_1(doc) ->
["OTP-2436, part 1"];
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 77d2579848..9b8905712e 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -40,9 +40,11 @@
%% phash2(Binary, N)
%%
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, init_per_testcase/2, fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2,
copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1,
bad_list_to_binary/1, bad_binary_to_list/1,
t_split_binary/1, bad_split/1, t_concat_binary/1,
@@ -61,24 +63,42 @@
%% Internal exports.
-export([sleeper/0]).
-all(suite) ->
- [copy_terms,conversions,deep_lists,deep_bitstr_lists,
+suite() -> [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,2}}].
+
+all() ->
+ [copy_terms, conversions, deep_lists, deep_bitstr_lists,
t_split_binary, bad_split, t_concat_binary,
- bad_list_to_binary, bad_binary_to_list, terms, terms_float,
- external_size, t_iolist_size,
- bad_binary_to_term_2,safe_binary_to_term2,
- bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary,
- more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order,
- gc_test, bit_sized_binary_sizes, otp_6817, otp_8117,
- deep,obsolete_funs,robustness,otp_8180].
+ bad_list_to_binary, bad_binary_to_list, terms,
+ terms_float, external_size, t_iolist_size,
+ bad_binary_to_term_2, safe_binary_to_term2,
+ bad_binary_to_term, bad_terms, t_hash, bad_size,
+ bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
+ ordering, unaligned_order, gc_test,
+ bit_sized_binary_sizes, otp_6817, otp_8117, deep,
+ obsolete_funs, robustness, otp_8180].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(2)),
- [{watchdog, Dog}|Config].
+ Config.
-fin_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+end_per_testcase(_Func, _Config) ->
+ ok.
-define(heap_binary_size, 64).
@@ -1041,7 +1061,7 @@ test_terms(Test_Func) ->
?line Test_Func(F = fun(A) -> 42*A end),
?line Test_Func(lists:duplicate(32, F)),
- ?line Test_Func(FF = fun binary_SUITE:all/1),
+ ?line Test_Func(FF = fun binary_SUITE:all/0),
?line Test_Func(lists:duplicate(32, FF)),
ok.
diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl
index 4e83d97689..c0d64c263e 100644
--- a/erts/emulator/test/bs_bincomp_SUITE.erl
+++ b/erts/emulator/test/bs_bincomp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -22,15 +22,34 @@
-module(bs_bincomp_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1,tracing/1]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [byte_aligned, bit_aligned, extended_byte_aligned,
+ extended_bit_aligned, mixed, tracing].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [byte_aligned,bit_aligned,extended_byte_aligned,
- extended_bit_aligned,mixed,tracing].
byte_aligned(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl
index 52bb925385..76d2661592 100644
--- a/erts/emulator/test/bs_bit_binaries_SUITE.erl
+++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -22,18 +22,38 @@
-module(bs_bit_binaries_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
misc/1,horrid_match/1,test_bitstr/1,test_bit_size/1,asymmetric_tests/1,
big_asymmetric_tests/1,binary_to_and_from_list/1,
big_binary_to_and_from_list/1,send_and_receive/1,
send_and_receive_alot/1,append/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [misc, horrid_match, test_bitstr, test_bit_size,
+ asymmetric_tests, big_asymmetric_tests,
+ binary_to_and_from_list, big_binary_to_and_from_list,
+ send_and_receive, send_and_receive_alot, append].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [misc,horrid_match,test_bitstr,test_bit_size,asymmetric_tests,
- big_asymmetric_tests,binary_to_and_from_list,big_binary_to_and_from_list,
- send_and_receive,send_and_receive_alot,append].
misc(Config) when is_list(Config) ->
?line <<1:100>> = id(<<1:100>>),
diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl
index 138a19a626..dd77278307 100644
--- a/erts/emulator/test/bs_construct_SUITE.erl
+++ b/erts/emulator/test/bs_construct_SUITE.erl
@@ -21,7 +21,8 @@
-module(bs_construct_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
test1/1, test2/1, test3/1, test4/1, test5/1, testf/1,
not_used/1, in_guard/1,
mem_leak/1, coerce_to_float/1, bjorn/1,
@@ -29,14 +30,30 @@
copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1,
otp_7422/1, zero_width/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
- [test1, test2, test3, test4, test5, testf,
- not_used, in_guard, mem_leak, coerce_to_float, bjorn,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [test1, test2, test3, test4, test5, testf, not_used,
+ in_guard, mem_leak, coerce_to_float, bjorn,
huge_float_field, huge_binary, system_limit, badarg,
- copy_writable_binary, kostis, dynamic, bs_add,
- otp_7422, zero_width].
+ copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
big(1) ->
57285702734876389752897683.
diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl
index 3d054a279f..5a028835e6 100644
--- a/erts/emulator/test/bs_match_bin_SUITE.erl
+++ b/erts/emulator/test/bs_match_bin_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,12 +19,32 @@
-module(bs_match_bin_SUITE).
--export([all/1,byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [byte_split_binary, bit_split_binary, match_huge_bin].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [byte_split_binary,bit_split_binary,match_huge_bin].
byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions.";
byte_split_binary(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl
index 99dee7c7bc..093ef906c8 100644
--- a/erts/emulator/test/bs_match_int_SUITE.erl
+++ b/erts/emulator/test/bs_match_int_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,16 +18,36 @@
-module(bs_match_int_SUITE).
--export([all/1,integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1,
match_huge_int/1,bignum/1,unaligned_32_bit/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-import(lists, [seq/2]).
-all(suite) ->
- [integer,signed_integer,dynamic,more_dynamic,mml,match_huge_int,bignum,
- unaligned_32_bit].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [integer, signed_integer, dynamic, more_dynamic, mml,
+ match_huge_int, bignum, unaligned_32_bit].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
integer(Config) when is_list(Config) ->
?line 0 = get_int(mkbin([])),
diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index 6de2ef67e5..ad21e01f7e 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,18 +18,38 @@
%%
-module(bs_match_misc_SUITE).
--export([all/1,bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
kenneth/1,encode_binary/1,native/1,happi/1,
size_var/1,wiger/1,x0_context/1,huge_float_field/1,
writable_binary_matched/1,otp_7198/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [bound_var, bound_tail, t_float, little_float, sean,
+ kenneth, encode_binary, native, happi, size_var, wiger,
+ x0_context, huge_float_field, writable_binary_matched,
+ otp_7198].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [bound_var,bound_tail,t_float,little_float,sean,
- kenneth,encode_binary,native,happi,
- size_var,wiger,x0_context,huge_float_field,
- writable_binary_matched,otp_7198].
bound_var(doc) -> "Test matching of bound variables.";
bound_var(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl
index b0b0779b65..b8f7789f60 100644
--- a/erts/emulator/test/bs_match_tail_SUITE.erl
+++ b/erts/emulator/test/bs_match_tail_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,11 +20,31 @@
-module(bs_match_tail_SUITE).
-author('[email protected]').
--export([all/1,aligned/1,unaligned/1,zero_tail/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [aligned, unaligned, zero_tail].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) -> [aligned,unaligned,zero_tail].
aligned(doc) -> "Test aligned tails.";
aligned(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl
index 87adc5197b..626a8b4cb6 100644
--- a/erts/emulator/test/bs_utf_SUITE.erl
+++ b/erts/emulator/test/bs_utf_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,13 +19,15 @@
-module(bs_utf_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1,
utf8_illegal_sequences/1,utf16_illegal_sequences/1,
utf32_illegal_sequences/1,
bad_construction/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
@@ -33,14 +35,32 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(6)),
[{watchdog,Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
- [utf8_roundtrip,utf16_roundtrip,utf32_roundtrip,
- utf8_illegal_sequences,utf16_illegal_sequences,
- utf32_illegal_sequences,bad_construction].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [utf8_roundtrip, utf16_roundtrip, utf32_roundtrip,
+ utf8_illegal_sequences, utf16_illegal_sequences,
+ utf32_illegal_sequences, bad_construction].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
utf8_roundtrip(Config) when is_list(Config) ->
?line utf8_roundtrip(0, 16#D7FF),
diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl
index 7350aef4ec..e754d161a3 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -19,21 +19,40 @@
-module(busy_port_SUITE).
--export([all/1, io_to_busy/1, message_order/1, send_3/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ io_to_busy/1, message_order/1, send_3/1,
system_monitor/1, no_trap_exit/1,
no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1,
hard_busy_driver/1, soft_busy_driver/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% Internal exports.
-export([init/2]).
-all(suite) -> {req, [dynamic_loading],
- [io_to_busy, message_order, send_3,
- system_monitor, no_trap_exit,
- no_trap_exit_unlinked, trap_exit, multiple_writers,
- hard_busy_driver, soft_busy_driver]}.
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [io_to_busy, message_order, send_3, system_monitor,
+ no_trap_exit, no_trap_exit_unlinked, trap_exit,
+ multiple_writers, hard_busy_driver, soft_busy_driver].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%% Tests I/O operations to a busy port, to make sure a suspended send
%% operation is correctly restarted. This used to crash Beam.
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index e0528955b0..11e8085cff 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,7 +20,9 @@
-module(call_trace_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1,
return_trace/1,exception_trace/1,on_load/1,deep_exception/1,
exception_nocatch/1,bit_syntax/1]).
@@ -35,25 +37,44 @@
-export([abbr/1,abbr/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(P, 20).
-all(suite) ->
- Common = [errors,on_load],
- NotHipe = [process_specs,basic,flags,pam,change_pam,return_trace,
- exception_trace,deep_exception,exception_nocatch,bit_syntax],
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ Common = [errors, on_load],
+ NotHipe = [process_specs, basic, flags, pam, change_pam,
+ return_trace, exception_trace, deep_exception,
+ exception_nocatch, bit_syntax],
Hipe = [hipe],
- case test_server:is_native(?MODULE) of
+ case test_server:is_native(call_trace_SUITE) of
true -> Hipe ++ Common;
false -> NotHipe ++ Common
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:seconds(30)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 5707de30d3..703a00a598 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -18,18 +18,38 @@
%%
-module(code_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
new_binary_types/1,t_check_process_code/1,t_check_process_code_ets/1,
external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
make_stub_many_funs/1,constant_pools/1,
false_dependency/1,coverage/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [new_binary_types, t_check_process_code,
+ t_check_process_code_ets, external_fun, get_chunk,
+ module_md5, make_stub, make_stub_many_funs,
+ constant_pools, false_dependency, coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [new_binary_types,t_check_process_code,t_check_process_code_ets,
- external_fun,get_chunk,module_md5,make_stub,make_stub_many_funs,
- constant_pools,false_dependency,coverage].
new_binary_types(Config) when is_list(Config) ->
?line Data = ?config(data_dir, Config),
diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl
index e3d34b923d..a8cc175303 100644
--- a/erts/emulator/test/crypto_SUITE.erl
+++ b/erts/emulator/test/crypto_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,14 +19,34 @@
-module(crypto_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1,
misc_errors/1]).
-all(suite) ->
- [t_md5,t_md5_update,error,unaligned_context,random_lists,misc_errors].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [t_md5, t_md5_update, error, unaligned_context,
+ random_lists, misc_errors].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
misc_errors(doc) ->
diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl
index 99107e3b57..b91535a50e 100644
--- a/erts/emulator/test/crypto_reference.erl
+++ b/erts/emulator/test/crypto_reference.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl
index 79047d7de5..ef607bf407 100644
--- a/erts/emulator/test/ddll_SUITE.erl
+++ b/erts/emulator/test/ddll_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,7 +30,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([all/1, ddll_test/1, errors/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, ddll_test/1, errors/1,
reference_count/1,
kill_port/1, dont_kill_port/1]).
-export([unload_on_process_exit/1, delayed_unload_with_ports/1,
@@ -50,35 +51,39 @@
-import(ordsets, [subtract/2]).
--include("test_server.hrl").
-
-all(suite) ->
- [ddll_test, errors,
- reference_count,
- kill_port,
- dont_kill_port,
- properties,
- load_and_unload,
- unload_on_process_exit,
- delayed_unload_with_ports,
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [ddll_test, errors, reference_count, kill_port,
+ dont_kill_port, properties, load_and_unload,
+ unload_on_process_exit, delayed_unload_with_ports,
unload_due_to_process_exit,
- no_unload_due_to_process_exit,
- no_unload_due_to_process_exit_2,
- unload_reload_thingie,
- unload_reload_thingie_2,
- unload_reload_thingie_3,
- reload_pending,
- load_fail_init,
- reload_pending_fail_init,
- reload_pending_kill,
- more_error_codes,
- forced_port_killing,
- no_trap_exit_and_kill_ports,
- monitor_demonitor,
- monitor_demonitor_load,
- new_interface,
- lock_driver
- ].
+ no_unload_due_to_process_exit,
+ no_unload_due_to_process_exit_2, unload_reload_thingie,
+ unload_reload_thingie_2, unload_reload_thingie_3,
+ reload_pending, load_fail_init,
+ reload_pending_fail_init, reload_pending_kill,
+ more_error_codes, forced_port_killing,
+ no_trap_exit_and_kill_ports, monitor_demonitor,
+ monitor_demonitor_load, new_interface, lock_driver].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
unload_on_process_exit(suite) ->
[];
diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl
index d9e961be2f..97ab470a3e 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -21,14 +21,34 @@
-module(decode_packet_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[basic, packet_size, neg, http, line, ssl, otp_8536].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Seed = {S1,S2,S3} = now(),
random:seed(S1,S2,S3),
@@ -36,7 +56,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(1)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl
index 881354b9da..27085b7b7e 100644
--- a/erts/emulator/test/dgawd_handler.erl
+++ b/erts/emulator/test/dgawd_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index f26455e6da..d62eb00919 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -22,31 +22,30 @@
%% Tests distribution and the tcp driver.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
- ping/1, bulk_send/1, bulk_send_small/1,
- bulk_send_big/1,
- bulk_send_bigbig/1,
- local_send/1, local_send_small/1, local_send_big/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ ping/1, bulk_send_small/1,
+ bulk_send_big/1, bulk_send_bigbig/1,
+ local_send_small/1, local_send_big/1,
local_send_legal/1, link_to_busy/1, exit_to_busy/1,
lost_exit/1, link_to_dead/1, link_to_dead_new_node/1,
applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1,
- trap_bif/1, trap_bif_1/1, trap_bif_2/1, trap_bif_3/1,
- stop_dist/1, dist_auto_connect/1,
+ trap_bif_1/1, trap_bif_2/1, trap_bif_3/1,
+ stop_dist/1,
dist_auto_connect_never/1, dist_auto_connect_once/1,
dist_parallel_send/1,
atom_roundtrip/1,
atom_roundtrip_r12b/1,
contended_atom_cache_entry/1,
bad_dist_structure/1,
- bad_dist_ext/1,
bad_dist_ext_receive/1,
bad_dist_ext_process_info/1,
bad_dist_ext_control/1,
bad_dist_ext_connection_id/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
%% Internal exports.
-export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0,
@@ -55,16 +54,39 @@
dist_evil_parallel_receiver/0,
sendersender/4, sendersender2/4]).
-all(suite) -> [
- ping, bulk_send, local_send, link_to_busy, exit_to_busy,
- lost_exit, link_to_dead, link_to_dead_new_node,
- applied_monitor_node, ref_port_roundtrip, nil_roundtrip,
- stop_dist, trap_bif, dist_auto_connect, dist_parallel_send,
- atom_roundtrip, atom_roundtrip_r12b,
- contended_atom_cache_entry,
- bad_dist_structure,
- bad_dist_ext
- ].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [ping, {group, bulk_send}, {group, local_send},
+ link_to_busy, exit_to_busy, lost_exit, link_to_dead,
+ link_to_dead_new_node, applied_monitor_node,
+ ref_port_roundtrip, nil_roundtrip, stop_dist,
+ {group, trap_bif}, {group, dist_auto_connect},
+ dist_parallel_send, atom_roundtrip, atom_roundtrip_r12b,
+ contended_atom_cache_entry, bad_dist_structure, {group, bad_dist_ext}].
+
+groups() ->
+ [{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]},
+ {local_send, [],
+ [local_send_small, local_send_big, local_send_legal]},
+ {trap_bif, [], [trap_bif_1, trap_bif_2, trap_bif_3]},
+ {dist_auto_connect, [],
+ [dist_auto_connect_never, dist_auto_connect_once]},
+ {bad_dist_ext, [],
+ [bad_dist_ext_receive, bad_dist_ext_process_info,
+ bad_dist_ext_control, bad_dist_ext_connection_id]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-define(DEFAULT_TIMETRAP, 4*60*1000).
@@ -72,7 +94,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?DEFAULT_TIMETRAP),
[{watchdog, Dog},{testcase, Func}|Config].
-fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
@@ -120,13 +142,6 @@ ping(Config) when is_list(Config) ->
ok.
-bulk_send(doc) ->
- ["Tests sending large amount of data to another node and measure",
- "the time. This tests that a process that is suspended on a ",
- "busy port will eventually be resumed."];
-bulk_send(suite) ->
- [bulk_send_small, bulk_send_big, bulk_send_bigbig].
-
bulk_send_small(Config) when is_list(Config) ->
?line bulk_send(64, 32).
@@ -257,17 +272,14 @@ receiver(Terms, Size) ->
end.
-local_send(suite) ->
- [local_send_small, local_send_big, local_send_legal];
-local_send(doc) ->
- ["Tests sending small and big messages to a non-existing ",
- "local registered process."].
local_send_big(doc) ->
["Sends several big message to an non-registered process on ",
"the local node."];
local_send_big(Config) when is_list(Config) ->
- Data0=local_send_big(doc)++local_send(doc),
+ Data0=local_send_big(doc)++
+ ["Tests sending small and big messages to a non-existing ",
+ "local registered process."],
Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0],
Data2=Data0++lists:flatten(Data1)++
list_to_binary(lists:flatten(Data1)),
@@ -753,9 +765,6 @@ stop_dist(Config) when is_list(Config) ->
ok.
-trap_bif(doc) ->
- ["Verifies that BIFs which are traps to Erlang work (OTP-2680)."];
-trap_bif(suite) -> [trap_bif_1, trap_bif_2, trap_bif_3].
trap_bif_1(doc) ->
[""];
@@ -792,10 +801,6 @@ tr3() ->
-dist_auto_connect(doc) ->
- ["Tests the kernel parameter 'dist_auto_connect'."];
-dist_auto_connect(suite) ->
- [dist_auto_connect_never, dist_auto_connect_once].
% This has to be done by nodes with differrent cookies, otherwise global
% will connect nodes, which is correct, but makes it hard to test.
@@ -1438,12 +1443,6 @@ bad_dist_structure(Config) when is_list(Config) ->
?t:timetrap_cancel(Dog),
ok.
-bad_dist_ext(doc) -> [];
-bad_dist_ext(suite) ->
- [bad_dist_ext_receive,
- bad_dist_ext_process_info,
- bad_dist_ext_control,
- bad_dist_ext_connection_id].
bad_dist_ext_receive(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index 39b2ed395f..6c85c2c3d1 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -27,12 +27,12 @@
%%% - queueing
-module(driver_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1,
+ end_per_suite/1, init_per_group/2,end_per_group/2,
init_per_testcase/2,
- fin_per_testcase/2,
- end_per_suite/1,
+ end_per_testcase/2,
outputv_echo/1,
- timer/1,
+
timer_measure/1,
timer_cancel/1,
timer_change/1,
@@ -51,7 +51,7 @@
'driver_system_info_ver1.1'/1,
driver_system_info_current_ver/1,
driver_monitor/1,
- ioq_exit/1,
+
ioq_exit_ready_input/1,
ioq_exit_ready_output/1,
ioq_exit_timeout/1,
@@ -78,7 +78,7 @@
-export([bin_prefix/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
% First byte in communication with the timer driver
@@ -120,49 +120,51 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
?line 0 = erts_debug:get_internal_state(check_io_debug),
[{watchdog, Dog},{testcase, Case}|Config].
-fin_per_testcase(Case, Config) ->
+end_per_testcase(Case, Config) ->
Dog = ?config(watchdog, Config),
- erlang:display({fin_per_testcase, Case}),
+ erlang:display({end_per_testcase, Case}),
?line 0 = erts_debug:get_internal_state(check_io_debug),
?t:timetrap_cancel(Dog).
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [fun_to_port, outputv_echo, queue_echo, {group, timer},
+ driver_unloaded, io_ready_exit, use_fallback_pollset,
+ bad_fd_in_pollset, driver_event, fd_change,
+ steal_control, otp_6602, 'driver_system_info_ver1.0',
+ 'driver_system_info_ver1.1',
+ driver_system_info_current_ver, driver_monitor,
+ {group, ioq_exit}, zero_extended_marker_garb_drv,
+ invalid_extended_marker_drv, larger_major_vsn_drv,
+ larger_minor_vsn_drv, smaller_major_vsn_drv,
+ smaller_minor_vsn_drv, peek_non_existing_queue,
+ otp_6879, caller, many_events, missing_callbacks,
+ smp_select, driver_select_use,
+ thread_mseg_alloc_cache_clean].
+
+groups() ->
+ [{timer, [],
+ [timer_measure, timer_cancel, timer_delay,
+ timer_change]},
+ {ioq_exit, [],
+ [ioq_exit_ready_input, ioq_exit_ready_output,
+ ioq_exit_timeout, ioq_exit_ready_async, ioq_exit_event,
+ ioq_exit_ready_input_async, ioq_exit_ready_output_async,
+ ioq_exit_timeout_async, ioq_exit_event_async]}].
+
+init_per_suite(Config) ->
+ Config.
+
end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false).
-all(suite) ->
- [
- fun_to_port,
- outputv_echo,
- queue_echo,
- timer,
- driver_unloaded,
- io_ready_exit,
- use_fallback_pollset,
- bad_fd_in_pollset,
- driver_event,
- fd_change,
- steal_control,
- otp_6602,
- 'driver_system_info_ver1.0',
- 'driver_system_info_ver1.1',
- driver_system_info_current_ver,
- driver_monitor,
- ioq_exit,
- zero_extended_marker_garb_drv,
- invalid_extended_marker_drv,
- larger_major_vsn_drv,
- larger_minor_vsn_drv,
- smaller_major_vsn_drv,
- smaller_minor_vsn_drv,
- peek_non_existing_queue,
- otp_6879,
- caller,
- many_events,
- missing_callbacks,
- smp_select,
- driver_select_use,
- thread_mseg_alloc_cache_clean
- ].
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
fun_to_port(doc) -> "Test sending a fun to port with an outputv-capable driver.";
fun_to_port(Config) when is_list(Config) ->
@@ -308,7 +310,6 @@ compare(Got, Expected) ->
%% Driver timer test suites
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-timer(suite) -> [timer_measure,timer_cancel,timer_delay,timer_change].
timer_measure(doc) -> ["Check that timers time out in good time."];
timer_measure(Config) when is_list(Config) ->
@@ -1299,17 +1300,6 @@ driver_monitor(Config) when is_list(Config) ->
?line stop_driver(Port, Name),
?line ok.
-ioq_exit(doc) -> [];
-ioq_exit(suite) ->
- [ioq_exit_ready_input,
- ioq_exit_ready_output,
- ioq_exit_timeout,
- ioq_exit_ready_async,
- ioq_exit_event,
- ioq_exit_ready_input_async,
- ioq_exit_ready_output_async,
- ioq_exit_timeout_async,
- ioq_exit_event_async].
-define(IOQ_EXIT_READY_INPUT, 1).
-define(IOQ_EXIT_READY_OUTPUT, 2).
@@ -1790,8 +1780,8 @@ mseg_alloc_ccc() ->
mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})).
mseg_alloc_ccc(MsegAllocInfo) ->
- ?line {value,{calls, CL}}
- = lists:keysearch(calls, 1, MsegAllocInfo),
+ ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo),
+ ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL),
?line {value,{mseg_check_cache, GigaCCC, CCC}}
= lists:keysearch(mseg_check_cache, 1, CL),
?line GigaCCC*1000000000 + CCC.
@@ -1800,12 +1790,28 @@ mseg_alloc_cached_segments() ->
mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})).
mseg_alloc_cached_segments(MsegAllocInfo) ->
+ MemName = case is_halfword_vm() of
+ true -> "high memory";
+ false -> "all memory"
+ end,
+ ?line [{memkind,DrvMem}]
+ = lists:filter(fun(E) -> case E of
+ {memkind, [{name, MemName} | _]} -> true;
+ _ -> false
+ end end, MsegAllocInfo),
?line {value,{status, SL}}
- = lists:keysearch(status, 1, MsegAllocInfo),
+ = lists:keysearch(status, 1, DrvMem),
?line {value,{cached_segments, CS}}
= lists:keysearch(cached_segments, 1, SL),
?line CS.
+is_halfword_vm() ->
+ case {erlang:system_info({wordsize, internal}),
+ erlang:system_info({wordsize, external})} of
+ {4, 8} -> true;
+ {WS, WS} -> false
+ end.
+
driver_alloc_sbct() ->
{_, _, _, As} = erlang:system_info(allocator),
case lists:keysearch(driver_alloc, 1, As) of
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index 1d66b6ef70..0cac0636e0 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -17,12 +17,32 @@
%% %CopyrightEnd%
-module(efile_SUITE).
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([iter_max_files/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [iter_max_files].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) -> [iter_max_files].
%%
%% Open as many files as possible. Do this several times and check
diff --git a/erts/emulator/test/emulator.spec b/erts/emulator/test/emulator.spec
index ed5bd48e84..1ea751cc3b 100644
--- a/erts/emulator/test/emulator.spec
+++ b/erts/emulator/test/emulator.spec
@@ -1 +1 @@
-{topcase, {dir, "../emulator_test"}}.
+{suites,"../emulator_test",all}.
diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl
index ea618e9feb..bc9e610af3 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE.erl
+++ b/erts/emulator/test/erl_drv_thread_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,18 +19,36 @@
-module(erl_drv_thread_SUITE).
-author('[email protected]').
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([basic/1, rwlock/1, tsd/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(DEFAULT_TIMETRAP_SECS, 240).
-all(doc) -> [];
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[basic, rwlock, tsd].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% Testcases %%
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index 11a7a61586..84d17c9596 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -28,9 +28,10 @@
-author('[email protected]').
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
% Test cases
-export([links/1,
@@ -46,7 +47,7 @@
otp_5772_dist_monitor/1,
otp_7946/1]).
--export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
% Internal exports
-export([test_proc/0]).
@@ -77,11 +78,29 @@
-all(suite) -> [links, dist_links, monitor_nodes, process_monitors,
- dist_process_monitors, busy_dist_port_monitor,
- busy_dist_port_link, otp_5772_link, otp_5772_dist_link,
- otp_5772_monitor, otp_5772_dist_monitor,
- otp_7946].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [links, dist_links, monitor_nodes, process_monitors,
+ dist_process_monitors, busy_dist_port_monitor,
+ busy_dist_port_link, otp_5772_link, otp_5772_dist_link,
+ otp_5772_monitor, otp_5772_dist_monitor, otp_7946].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false).
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
links(doc) -> ["Tests node local links"];
links(suite) -> [];
@@ -678,13 +697,10 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
end,
?line [{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
?line Dog = ?config(watchdog, Config),
?line ?t:timetrap_cancel(Dog).
-end_per_suite(_Config) ->
- catch erts_debug:set_internal_state(available_internal_state, false).
-
tp_call(Tp, Fun) ->
?line R = make_ref(),
?line Tp ! {call, self(), R, Fun},
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 934a1b10a4..9a6a6f4c05 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,19 +18,40 @@
%%
-module(erts_debug_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
- flat_size/1,flat_size_big/1,df/1,instructions/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
+ flat_size/1,flat_size_big/1,df/1,
+ instructions/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [flat_size, flat_size_big, df, instructions].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [flat_size,flat_size_big,df,instructions].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(2)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index 7fb92faf0d..a4cb76dde1 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,8 +18,9 @@
-module(estone_SUITE).
%% Test functions
--export([all/1,estone/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,estone/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
%% Internal exports for EStone tests
-export([lists/1,
@@ -44,7 +45,7 @@
run_micro/3,p1/1,ppp/3,macro/2,micros/0]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% Test suite defines
-define(default_timeout, ?t:minutes(10)).
@@ -68,12 +69,31 @@
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-all(suite) -> [estone].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [estone].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
estone(suite) ->
[];
diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl
index a8288584f4..5c59184fe2 100644
--- a/erts/emulator/test/evil_SUITE.erl
+++ b/erts/emulator/test/evil_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,9 @@
-module(evil_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
heap_frag/1,
encode_decode_ext/1,
decode_integer_ext/1,
@@ -30,26 +32,37 @@
decode_pos_neg_zero/1
]).
--include("test_server.hrl").
-
-all(suite) ->
- [
- heap_frag,
- encode_decode_ext,
- decode_integer_ext,
- decode_small_big_ext,
- decode_large_big_ext,
- decode_small_big_ext_neg,
- decode_large_big_ext_neg,
- decode_too_small,
- decode_pos_neg_zero
- ].
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [heap_frag, encode_decode_ext, decode_integer_ext,
+ decode_small_big_ext, decode_large_big_ext,
+ decode_small_big_ext_neg, decode_large_big_ext_neg,
+ decode_too_small, decode_pos_neg_zero].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(?t:minutes(0.5)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index f1e6e004ad..7041ad32de 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,20 +19,40 @@
-module(exception_SUITE).
--export([all/1, badmatch/1, pending_errors/1, nil_arith/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ badmatch/1, pending_errors/1, nil_arith/1,
stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1,
exception_with_heap_frag/1]).
-export([bad_guy/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-import(lists, [foreach/2]).
-all(suite) ->
- [badmatch, pending_errors, nil_arith,
- stacktrace, nested_stacktrace, raise, gunilla, per,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [badmatch, pending_errors, nil_arith, stacktrace,
+ nested_stacktrace, raise, gunilla, per,
exception_with_heap_frag].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
-define(try_match(E),
catch ?MODULE:bar(),
{'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))).
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl
index 99e9457985..c79a1d9900 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,11 @@
-module(float_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,
bad_float_unpack/1]).
-export([otp_7178/1]).
@@ -31,18 +33,31 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(3)),
[{watchdog, Dog},{testcase,Func}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
- [fpe,
- fp_drv,
- fp_drv_thread,
- otp_7178,
- denormalized,
- match,
- bad_float_unpack].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized,
+ match, bad_float_unpack].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%%
%% OTP-7178, list_to_float on very small numbers should give 0.0
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index a7889dfe90..4b59bfd6a5 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -22,7 +22,9 @@
-define(default_timeout, ?t:minutes(1)).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1,
equality/1,ordering/1,
fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1,
@@ -32,19 +34,37 @@
-export([nothing/0]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [bad_apply, bad_fun_call, badarity, ext_badarity,
+ equality, ordering, fun_to_port, t_hash, t_phash,
+ t_phash2, md5, refc, refc_ets, refc_dist,
+ const_propagation, t_arity, t_is_function2, t_fun_info].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [bad_apply,bad_fun_call,badarity,ext_badarity,equality,ordering,
- fun_to_port,t_hash,t_phash,t_phash2,md5,
- refc,refc_ets,refc_dist,const_propagation,
- t_arity,t_is_function2,t_fun_info].
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/fun_r12_SUITE.erl b/erts/emulator/test/fun_r12_SUITE.erl
index 9262731dcb..9421b60f49 100644
--- a/erts/emulator/test/fun_r12_SUITE.erl
+++ b/erts/emulator/test/fun_r12_SUITE.erl
@@ -20,18 +20,39 @@
-module(fun_r12_SUITE).
-compile(r12).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,dist_old_release/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,dist_old_release/1]).
-define(default_timeout, ?t:minutes(1)).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [dist_old_release].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) -> [dist_old_release].
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl
index 066aa215b2..9ce8d18346 100644
--- a/erts/emulator/test/gc_SUITE.erl
+++ b/erts/emulator/test/gc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,15 +21,34 @@
-module(gc_SUITE).
--include("test_server.hrl").
--export([all/1]).
+-include_lib("test_server/include/test_server.hrl").
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-define(default_timeout, ?t:minutes(10)).
-export([grow_heap/1, grow_stack/1, grow_stack_heap/1]).
-all(suite) ->
- [grow_heap,grow_stack, grow_stack_heap].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [grow_heap, grow_stack, grow_stack_heap].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
grow_heap(doc) -> ["Produce a growing list of elements, ",
"for X calls, then drop one item per call",
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index 8fef36dfaf..a3be387a5b 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -19,16 +19,37 @@
-module(guard_SUITE).
--export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1,
+ test_heap_guards/1, guard_bifs/1,
type_tests/1,guard_bif_binary_part/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-export([init/3]).
-import(lists, [member/2]).
-all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs,
- type_tests, guard_bif_binary_part].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [bad_arith, bad_tuple, test_heap_guards, guard_bifs,
+ type_tests, guard_bif_binary_part].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly.";
bad_arith(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl
index f5d1871bfb..257bee0b78 100644
--- a/erts/emulator/test/hash_SUITE.erl
+++ b/erts/emulator/test/hash_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -49,7 +49,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-endif.
-ifdef(debug).
@@ -69,22 +69,40 @@ config(priv_dir,_) ->
".".
-else.
%% When run in test server.
--export([all/1,test_basic/1,test_cmp/1,test_range/1,test_spread/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ test_basic/1,test_cmp/1,test_range/1,test_spread/1,
test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1,
- fin_per_testcase/2,init_per_testcase/2]).
+ end_per_testcase/2,init_per_testcase/2]).
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:minutes(10)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(doc) ->
- ["Test erlang:phash"];
-all(suite) ->
- [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292,
- bit_level_binaries, otp_7127].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [test_basic, test_cmp, test_range, test_spread,
+ test_phash2, otp_5292, bit_level_binaries, otp_7127].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
test_basic(suite) ->
[];
diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl
index 4d36076d12..b8dc87db7f 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,23 +19,44 @@
-module(hibernate_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
basic/1,min_heap_size/1,bad_args/1,
messages_in_queue/1,undefined_mfa/1, no_heap/1]).
%% Used by test cases.
-export([basic_hibernator/1,messages_in_queue_restart/2, no_heap_loop/0]).
-all(suite) ->
- [basic,min_heap_size,bad_args,messages_in_queue,undefined_mfa,no_heap].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic, min_heap_size, bad_args, messages_in_queue,
+ undefined_mfa, no_heap].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(3)),
[{watchdog,Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl
index 1d738cbafd..8b1ac0fe6c 120000..100644
--- a/erts/emulator/test/ignore_cores.erl
+++ b/erts/emulator/test/ignore_cores.erl
@@ -1 +1,158 @@
-../../test/ignore_cores.erl \ No newline at end of file
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : ignore_cores.erl
+%%% Author : Rickard Green <[email protected]>
+%%% Description :
+%%%
+%%% Created : 11 Feb 2008 by Rickard Green <[email protected]>
+%%%-------------------------------------------------------------------
+
+-module(ignore_cores).
+
+-include_lib("test_server/include/test_server.hrl").
+
+-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
+
+-record(ignore_cores, {org_cwd,
+ org_path,
+ org_pwd_env,
+ ign_dir = false,
+ cores_dir = false}).
+
+%%
+%% Takes a testcase config
+%%
+
+init(Config) ->
+ {ok, OrgCWD} = file:get_cwd(),
+ [{ignore_cores,
+ #ignore_cores{org_cwd = OrgCWD,
+ org_path = code:get_path(),
+ org_pwd_env = os:getenv("PWD")}}
+ | lists:keydelete(ignore_cores, 1, Config)].
+
+fini(Config) ->
+ #ignore_cores{org_cwd = OrgCWD,
+ org_path = OrgPath,
+ org_pwd_env = OrgPWD} = ?config(ignore_cores, Config),
+ ok = file:set_cwd(OrgCWD),
+ true = code:set_path(OrgPath),
+ case OrgPWD of
+ false -> ok;
+ _ -> true = os:putenv("PWD", OrgPWD)
+ end,
+ lists:keydelete(ignore_cores, 1, Config).
+
+setup(Suite, Testcase, Config) ->
+ setup(Suite, Testcase, Config, false).
+
+setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite),
+ is_atom(Testcase),
+ is_list(Config) ->
+ #ignore_cores{org_cwd = OrgCWD,
+ org_path = OrgPath,
+ org_pwd_env = OrgPWD} = ?config(ignore_cores, Config),
+ Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath),
+ true = code:set_path(Path),
+ PrivDir = ?config(priv_dir, Config),
+ IgnDir = filename:join([PrivDir,
+ atom_to_list(Suite)
+ ++ "_"
+ ++ atom_to_list(Testcase)
+ ++ "_wd"]),
+ ok = file:make_dir(IgnDir),
+ case SetCwd of
+ false ->
+ ok;
+ _ ->
+ ok = file:set_cwd(IgnDir),
+ OrgPWD = case os:getenv("PWD") of
+ false -> false;
+ PWD ->
+ os:putenv("PWD", IgnDir),
+ PWD
+ end
+ end,
+ ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>),
+ %% cores are dumped in /cores on MacOS X
+ CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of
+ {{unix,darwin}, true} ->
+ filelib:fold_files("/cores",
+ "^core.*$",
+ false,
+ fun (C,Cs) -> [C|Cs] end,
+ []);
+ _ ->
+ false
+ end,
+ lists:keyreplace(ignore_cores,
+ 1,
+ Config,
+ {ignore_cores,
+ #ignore_cores{org_cwd = OrgCWD,
+ org_path = OrgPath,
+ org_pwd_env = OrgPWD,
+ ign_dir = IgnDir,
+ cores_dir = CoresDir}}).
+
+restore(Config) ->
+ #ignore_cores{org_cwd = OrgCWD,
+ org_path = OrgPath,
+ org_pwd_env = OrgPWD,
+ ign_dir = IgnDir,
+ cores_dir = CoresDir} = ?config(ignore_cores, Config),
+ try
+ case CoresDir of
+ false ->
+ ok;
+ _ ->
+ %% Move cores dumped by these testcases in /cores
+ %% to cwd.
+ lists:foreach(fun (C) ->
+ case lists:member(C, CoresDir) of
+ true -> ok;
+ _ ->
+ Dst = filename:join(
+ [IgnDir,
+ filename:basename(C)]),
+ {ok, _} = file:copy(C, Dst),
+ file:delete(C)
+ end
+ end,
+ filelib:fold_files("/cores",
+ "^core.*$",
+ false,
+ fun (C,Cs) -> [C|Cs] end,
+ []))
+ end
+ after
+ catch file:set_cwd(OrgCWD),
+ catch code:set_path(OrgPath),
+ case OrgPWD of
+ false -> ok;
+ _ -> catch os:putenv("PWD", OrgPWD)
+ end
+ end.
+
+
+dir(Config) ->
+ #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config),
+ Dir.
diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl
index 65ea88eb2f..ef0929e769 100644
--- a/erts/emulator/test/list_bif_SUITE.erl
+++ b/erts/emulator/test/list_bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,21 +18,42 @@
%%
-module(list_bif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2]).
-export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1,
t_list_to_float/1,t_list_to_integer/1]).
-all(suite) ->
- [hd_test,tl_test,t_length,t_list_to_pid,t_list_to_float,t_list_to_integer].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [hd_test, tl_test, t_length, t_list_to_pid,
+ t_list_to_float, t_list_to_integer].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:seconds(60)),
[{watchdog,Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl
index 28626d26fb..28a4fba9f6 100644
--- a/erts/emulator/test/long_timers_test.erl
+++ b/erts/emulator/test/long_timers_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 69c89f5d2d..6bddbb14f5 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,7 +19,8 @@
-module(match_spec_SUITE).
--export([all/1, not_run/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, not_run/1]).
-export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1,
trace_control_word/1, silent/1, silent_no_ms/1,
ms_trace2/1, ms_trace3/1, boxed_and_small/1,
@@ -29,34 +30,53 @@
-export([runner/2]).
-export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]).
--export([do_boxed_and_small/0]).
+-export([do_boxed_and_small/0, suite/0]).
% This test suite assumes that tracing in general works. What we test is
% the match spec functionality.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:seconds(10)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
- case test_server:is_native(?MODULE) of
- false -> [test_1, test_2, test_3, bad_match_spec_bin,
- trace_control_word, silent, silent_no_ms,
- ms_trace2, ms_trace3, boxed_and_small,
- destructive_in_test_bif, guard_exceptions,
- unary_plus, unary_minus, fpe, moving_labels];
- true -> [not_run]
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(match_spec_SUITE) of
+ false ->
+ [test_1, test_2, test_3, bad_match_spec_bin,
+ trace_control_word, silent, silent_no_ms, ms_trace2,
+ ms_trace3, boxed_and_small, destructive_in_test_bif,
+ guard_exceptions, unary_plus, unary_minus, fpe,
+ moving_labels];
+ true -> [not_run]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped, "Native Code"}.
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index f34a2b496c..a2a052671f 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,11 @@
-module(module_info_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
exports/1,functions/1,native/1]).
%%-compile(native).
@@ -29,8 +31,29 @@
%% Helper.
-export([native_proj/1,native_filter/1]).
-all(suite) ->
- [exports,functions,native].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ modules().
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+modules() ->
+ [exports, functions, native].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(3)),
@@ -42,14 +65,18 @@ end_per_testcase(_Func, Config) ->
%% Should return all functions exported from this module. (local)
all_exported() ->
- All = add_arity(all(suite)),
- lists:sort([{all,1},{init_per_testcase,2},{end_per_testcase,2},
+ All = add_arity(modules()),
+ lists:sort([{all,0},{suite,0},{groups,0},
+ {init_per_suite,1},{end_per_suite,1},
+ {init_per_group,2},{end_per_group,2},
+ {init_per_testcase,2},{end_per_testcase,2},
{module_info,0},{module_info,1},{native_proj,1},
{native_filter,1}|All]).
%% Should return all functions in this module. (local)
all_functions() ->
- Locals = [{add_arity,1},{add_arity,2},{all_exported,0},{all_functions,0}],
+ Locals = [{add_arity,1},{add_arity,2},{all_exported,0},{all_functions,0},
+ {modules,0}],
lists:sort(Locals++all_exported()).
%% Test that the list of exported functions from this module is correct.
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index 68e378dfec..9cf4ed702a 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,29 +19,49 @@
-module(monitor_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1,
- demon_2/1, demon_3/1, demonitor_flush/1, remove_monitor/1,
+ demon_2/1, demon_3/1, demonitor_flush/1,
local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1,
large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
-export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]).
-all(suite) ->
- [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, demon_1, mon_1,
- mon_2, demon_2, demon_3, demonitor_flush, remove_monitor,
- large_exit, list_cleanup, mixer, named_down,
- otp_5827].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1,
+ demon_1, mon_1, mon_2, demon_2, demon_3,
+ demonitor_flush, {group, remove_monitor}, large_exit,
+ list_cleanup, mixer, named_down, otp_5827].
+
+groups() ->
+ [{remove_monitor, [],
+ [local_remove_monitor, remote_remove_monitor]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(15)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
@@ -315,8 +335,6 @@ demonitor_flush_test(Node) ->
-define(RM_MON_GROUPS, 100).
-define(RM_MON_GPROCS, 100).
-remove_monitor(suite) ->
- [local_remove_monitor, remote_remove_monitor].
local_remove_monitor(Config) when is_list(Config) ->
Gs = generate(fun () -> start_remove_monitor_group(node()) end,
diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl
index ae77fe4d89..d379b8a7fa 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -26,9 +26,11 @@
%%-define(line_trace,true).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/1, init_per_suite/1, end_per_suite/1, init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0,suite/0,groups/0,
+ init_per_group/2,end_per_group/2, init_per_suite/1,
+ end_per_suite/1, init_per_testcase/2, end_per_testcase/2]).
-export([long_rwlock/1,
hammer_ets_rwlock/1,
@@ -66,19 +68,16 @@ init_per_testcase(_Case, Config) ->
Dog = ?t:timetrap(?t:minutes(15)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
- [
- long_rwlock,
- hammer_rwlock_check,
- hammer_rwlock,
- hammer_tryrwlock_check,
- hammer_tryrwlock,
- hammer_ets_rwlock,
- hammer_sched_long_rwlock_check,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [long_rwlock, hammer_rwlock_check, hammer_rwlock,
+ hammer_tryrwlock_check, hammer_tryrwlock,
+ hammer_ets_rwlock, hammer_sched_long_rwlock_check,
hammer_sched_long_rwlock,
hammer_sched_long_freqread_rwlock_check,
hammer_sched_long_freqread_rwlock,
@@ -86,15 +85,22 @@ all(suite) ->
hammer_sched_long_tryrwlock,
hammer_sched_long_freqread_tryrwlock_check,
hammer_sched_long_freqread_tryrwlock,
- hammer_sched_rwlock_check,
- hammer_sched_rwlock,
+ hammer_sched_rwlock_check, hammer_sched_rwlock,
hammer_sched_freqread_rwlock_check,
hammer_sched_freqread_rwlock,
- hammer_sched_tryrwlock_check,
- hammer_sched_tryrwlock,
+ hammer_sched_tryrwlock_check, hammer_sched_tryrwlock,
hammer_sched_freqread_tryrwlock_check,
- hammer_sched_freqread_tryrwlock
- ].
+ hammer_sched_freqread_tryrwlock].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
long_rwlock(Config) when is_list(Config) ->
statistics(runtime),
diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl
index 310892424e..f889712f46 100644
--- a/erts/emulator/test/nested_SUITE.erl
+++ b/erts/emulator/test/nested_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,11 +19,33 @@
-module(nested_SUITE).
--export([all/1, case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [case_in_case, case_in_after, catch_in_catch,
+ bif_in_bif].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) -> [case_in_case, case_in_after, catch_in_catch, bif_in_bif].
case_in_case(suite) -> [];
case_in_case(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 42947aa6be..54cbf6b974 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -23,14 +23,18 @@
-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
%%-define(CHECK(Exp,Got), ?line Exp = Got).
--include("test_server.hrl").
-
--export([all/1,
- %%init_per_testcase/2,
- fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
- types/1, many_args/1, binaries/1, get_string/1, get_atom/1, api_macros/1,
- from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1,
- threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1,
+-include_lib("test_server/include/test_server.hrl").
+
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,
+ end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
+ types/1, many_args/1, binaries/1, get_string/1, get_atom/1,
+ api_macros/1,
+ from_array/1, iolist_as_binary/1, resource/1, resource_binary/1,
+ resource_takeover/1,
+ threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1,
+ is_checks/1,
get_length/1, make_atom/1, make_string/1]).
-export([many_args_100/100]).
@@ -40,7 +44,7 @@
%% list_seq/1,type_test/0,tuple_2_list/1,is_identical/2,compare/2,
%% clone_bin/1,make_sub_bin/3,string_to_bin/2,atom_to_bin/2,macros/1,
%% tuple_2_list_and_tuple/1,iolist_2_bin/1,get_resource_type/1,alloc_resource/2,
-%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0,
+%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0, suite/0,
%% make_new_resource/2,make_new_resource_binary/1,send_list_seq/2,send_new_blob/2,
%% alloc_msgenv/0,clear_msgenv/1,grow_blob/2,send_blob/2,send_blob_thread/3,
%% join_send_thread/1]).
@@ -48,17 +52,37 @@
-define(nif_stub,nif_stub_error(?LINE)).
-all(suite) ->
- [basic, reload, upgrade, heap_frag, types, many_args, binaries, get_string,
- get_atom, api_macros, from_array, iolist_as_binary, resource, resource_binary,
- resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks,
- get_length, make_atom, make_string].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic, reload, upgrade, heap_frag, types, many_args,
+ binaries, get_string, get_atom, api_macros, from_array,
+ iolist_as_binary, resource, resource_binary,
+ resource_takeover, threading, send, send2, send3,
+ send_threaded, neg, is_checks, get_length, make_atom,
+ make_string].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
-%%init_per_testcase(_Case, Config) ->
-%% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)),
-%% [{watchdog, Dog}|Config].
+init_per_testcase(_Case, Config) ->
+% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)),
+ Config.
-fin_per_testcase(_Func, _Config) ->
+end_per_testcase(_Func, _Config) ->
%%Dog = ?config(watchdog, Config),
%%?t:timetrap_cancel(Dog),
P1 = code:purge(nif_mod),
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
index 7888a589e7..b99a2c90ee 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
@@ -19,7 +19,7 @@
-module(nif_mod).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0,
get_priv_data_ptr/0, make_new_resource/2, get_resource/2]).
diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl
index 9df2158200..b393e29b82 100644
--- a/erts/emulator/test/nif_SUITE_data/tester.erl
+++ b/erts/emulator/test/nif_SUITE_data/tester.erl
@@ -1,6 +1,6 @@
-module(tester).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-export([load_nif_lib/2, run/0]).
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index f3d9eb783b..416fdad941 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -29,10 +29,12 @@
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%-compile(export_all).
--export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, init_per_testcase/2,
+ end_per_testcase/2,
node_container_refc_check/1]).
-export([term_to_binary_to_term_eq/1,
@@ -55,25 +57,30 @@
-define(DEFAULT_TIMEOUT, ?t:minutes(10)).
-all(doc) -> [];
-all(suite) ->
- [term_to_binary_to_term_eq,
- round_trip_eq,
- cmp,
- ref_eq,
- node_table_gc,
- dist_link_refc,
- dist_monitor_refc,
- node_controller_refc,
- ets_refc,
- match_spec_refc,
- timer_refc,
- otp_4715,
- pid_wrap,
- port_wrap,
- bad_nc,
- unique_pid,
- iter_max_procs].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq,
+ node_table_gc, dist_link_refc, dist_monitor_refc,
+ node_controller_refc, ets_refc, match_spec_refc,
+ timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc,
+ unique_pid, iter_max_procs].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ available_internal_state(false).
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
available_internal_state(Bool) when Bool == true; Bool == false ->
case {Bool,
@@ -95,14 +102,11 @@ init_per_testcase(_Case, Config) when is_list(Config) ->
available_internal_state(true),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-end_per_suite(_Config) ->
- available_internal_state(false).
-
%%%
%%% The test cases -------------------------------------------------------------
%%%
diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl
index ece55f433c..9287158981 100644
--- a/erts/emulator/test/nofrag_SUITE.erl
+++ b/erts/emulator/test/nofrag_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,11 @@
-module(nofrag_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
error_handler/1,error_handler_apply/1,
error_handler_fixed_apply/1,error_handler_fun/1,
error_handler_tuple_fun/1,
@@ -30,9 +32,28 @@
%% Exported functions for an error_handler module.
-export([undefined_function/3,undefined_lambda/3,breakpoint/3]).
-all(suite) ->
- [error_handler,error_handler_apply,error_handler_fixed_apply,
- error_handler_fun,error_handler_tuple_fun,debug_breakpoint].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [error_handler, error_handler_apply,
+ error_handler_fixed_apply, error_handler_fun,
+ error_handler_tuple_fun, debug_breakpoint].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(3)),
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index d009994e2d..bf101b038d 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,7 +19,7 @@
-module(num_bif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% Tests the BIFs:
%% abs/1
@@ -31,15 +31,36 @@
%% round/1
%% trunc/1
--export([all/1, t_abs/1, t_float/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, t_abs/1, t_float/1,
t_float_to_list/1, t_integer_to_list/1,
t_list_to_integer/1,
- t_list_to_float/1, t_list_to_float_safe/1, t_list_to_float_risky/1,
+ t_list_to_float_safe/1, t_list_to_float_risky/1,
t_round/1, t_trunc/1]).
-all(suite) -> [t_abs, t_float, t_float_to_list, t_integer_to_list,
- t_list_to_float, t_list_to_integer,
- t_round, t_trunc].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [t_abs, t_float, t_float_to_list, t_integer_to_list,
+ {group, t_list_to_float}, t_list_to_integer, t_round,
+ t_trunc].
+
+groups() ->
+ [{t_list_to_float, [],
+ [t_list_to_float_safe, t_list_to_float_risky]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
t_abs(Config) when is_list(Config) ->
%% Floats.
@@ -140,7 +161,6 @@ t_integer_to_list(Config) when is_list(Config) ->
%% Tests list_to_float/1.
-t_list_to_float(suite) -> [t_list_to_float_safe, t_list_to_float_risky].
t_list_to_float_safe(Config) when is_list(Config) ->
?line 0.0 = list_to_float(id("0.0")),
diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl
index 6c47ba6f8f..124842390a 100644
--- a/erts/emulator/test/old_mod.erl
+++ b/erts/emulator/test/old_mod.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl
index 70348f64db..6f9c0a9dab 100644
--- a/erts/emulator/test/old_scheduler_SUITE.erl
+++ b/erts/emulator/test/old_scheduler_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,24 +19,44 @@
-module(old_scheduler_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
-export([equal/1, many_low/1, few_low/1, max/1, high/1]).
-define(default_timeout, ?t:minutes(11)).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
case catch erlang:system_info(modified_timing_level) of
Level when is_integer(Level) ->
{skipped,
- "Modified timing (level " ++ integer_to_list(Level)
- ++ ") is enabled. Testcases gets messed up by modfied "
- "timing."};
- _ ->
- [equal, many_low, few_low, max, high]
+ "Modified timing (level " ++
+ integer_to_list(Level) ++
+ ") is enabled. Testcases gets messed "
+ "up by modfied timing."};
+ _ -> [equal, many_low, few_low, max, high]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
%%-----------------------------------------------------------------------------------
%% TEST SUITE DESCRIPTION
%%
@@ -63,7 +83,7 @@ init_per_testcase(_Case, Config) ->
?line MS = erlang:system_flag(multi_scheduling, block),
[{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
erlang:system_flag(multi_scheduling, unblock),
Dog=?config(watchdog, Config),
Prio=?config(prio, Config),
diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl
index 55d8d9ab0f..7bea35e980 100644
--- a/erts/emulator/test/op_SUITE.erl
+++ b/erts/emulator/test/op_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,22 +19,43 @@
-module(op_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]).
-export([]).
-import(lists, [foldl/3,flatmap/2]).
-all(suite) ->
- [bsl_bsr,logical,t_not,relop_simple,relop,complex_relop].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [bsl_bsr, logical, t_not, relop_simple, relop,
+ complex_relop].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 7fe532abd0..6da9a7e0ad 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -73,18 +73,19 @@
%%
--export([all/1, init_per_testcase/2, fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2,
init_per_suite/1, end_per_suite/1,
- stream/1, stream_small/1, stream_big/1,
+ stream_small/1, stream_big/1,
basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1,
- multiple_packets/1, mul_basic/1, mul_slow_writes/1,
+ mul_basic/1, mul_slow_writes/1,
dying_port/1, port_program_with_path/1,
open_input_file_port/1, open_output_file_port/1,
iter_max_ports/1, eof/1, input_only/1, output_only/1,
name1/1,
- t_binary/1, options/1, parallell/1, t_exit/1,
+ t_binary/1, parallell/1, t_exit/1,
env/1, bad_env/1, cd/1, exit_status/1,
- tps/1, tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1,
+ tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1,
otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1,
mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1,
exit_status_multi_scheduling_block/1, ports/1,
@@ -98,31 +99,42 @@
-export([otp_3906_forker/5, otp_3906_start_forker_starter/4]).
-export([env_slave_main/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-include_lib("kernel/include/file.hrl").
-all(suite) ->
- [
- otp_6224, stream, basic_ping, slow_writes, bad_packet,
- bad_port_messages, options, multiple_packets, parallell,
- dying_port, port_program_with_path,
- open_input_file_port, open_output_file_port,
- name1,
- env, bad_env, cd, exit_status,
- iter_max_ports, t_exit, tps, line, stderr_to_stdout,
- otp_3906, otp_4389, win_massive, mix_up_ports,
- otp_5112, otp_5119,
- exit_status_multi_scheduling_block,
- ports, spawn_driver, spawn_executable, close_deaf_port,
- unregister_name
- ].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [otp_6224, {group, stream}, basic_ping, slow_writes,
+ bad_packet, bad_port_messages, {group, options},
+ {group, multiple_packets}, parallell, dying_port,
+ port_program_with_path, open_input_file_port,
+ open_output_file_port, name1, env, bad_env, cd,
+ exit_status, iter_max_ports, t_exit, {group, tps}, line,
+ stderr_to_stdout, otp_3906, otp_4389, win_massive,
+ mix_up_ports, otp_5112, otp_5119,
+ exit_status_multi_scheduling_block, ports, spawn_driver,
+ spawn_executable, close_deaf_port, unregister_name].
+
+groups() ->
+ [{stream, [], [stream_small, stream_big]},
+ {options, [], [t_binary, eof, input_only, output_only]},
+ {multiple_packets, [], [mul_basic, mul_slow_writes]},
+ {tps, [], [tps_16_bytes, tps_1K]}].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
-define(DEFAULT_TIMEOUT, ?t:minutes(5)).
init_per_testcase(Case, Config) ->
[{testcase, Case} |Config].
-fin_per_testcase(_Case, _Config) ->
+end_per_testcase(_Case, _Config) ->
ok.
init_per_suite(Config) when is_list(Config) ->
@@ -191,7 +203,6 @@ win_massive_loop(P,N) ->
-stream(suite) -> [stream_small, stream_big].
%% Test that we can send a stream of bytes and get it back.
%% We will send only a small amount of data, to avoid deadlock.
@@ -304,7 +315,6 @@ bad_message(PortTest, Message) ->
%% Tests various options (stream and {packet, Number} are implicitly
%% tested in other test cases).
-options(suite) -> [t_binary, eof, input_only, output_only].
%% Tests the 'binary' option for a port.
@@ -416,7 +426,6 @@ output_and_verify(Config, Filename, Options, Data) ->
%% Test that receiving several packages written in the same
%% write operation works.
-multiple_packets(suite) -> [mul_basic, mul_slow_writes].
%% Basic test of receiving multiple packages, written in
%% one operation by the other end.
@@ -740,7 +749,6 @@ suicide_port(Config) when is_list(Config) ->
?line exit(Port, die),
?line receive after infinity -> ok end.
-tps(suite) -> [tps_16_bytes, tps_1K].
tps_16_bytes(doc) -> "";
tps_16_bytes(suite) -> [];
@@ -1049,8 +1057,10 @@ otp_3906(Config) when is_list(Config) ->
-define(OTP_3906_MAX_CONC_OSP, 50).
otp_3906(Config, OSName) ->
- ?line TSDir = filename:dirname(code:which(test_server)),
- ?line {ok, Variables} = file:consult(filename:join(TSDir, "variables")),
+ ?line DataDir = filename:dirname(proplists:get_value(data_dir,Config)),
+ ?line {ok, Variables} = file:consult(
+ filename:join([DataDir,"..","..",
+ "test_server","variables"])),
case lists:keysearch('CC', 1, Variables) of
{value,{'CC', CC}} ->
SuiteDir = filename:dirname(code:which(?MODULE)),
diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl
index f4e0bb9fa8..946978c580 100644
--- a/erts/emulator/test/port_bif_SUITE.erl
+++ b/erts/emulator/test/port_bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,25 +20,47 @@
-module(port_bif_SUITE).
--export([all/1, command/1, command_e/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, command/1,
command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1,
- port_info/1, port_info1/1, port_info2/1,
+ port_info1/1, port_info2/1,
connect/1, control/1, echo_to_busy/1]).
-export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [command, {group, port_info}, connect, control,
+ echo_to_busy].
+
+groups() ->
+ [{command_e, [],
+ [command_e_1, command_e_2, command_e_3, command_e_4]},
+ {port_info, [], [port_info1, port_info2]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [command, port_info, connect, control, echo_to_busy].
init_per_testcase(_Func, Config) when is_list(Config) ->
Dog=test_server:timetrap(test_server:minutes(10)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) when is_list(Config) ->
+end_per_testcase(_Func, Config) when is_list(Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog).
@@ -69,11 +91,6 @@ do_command(P, Data) ->
end.
-command_e(suite) -> [command_e_1,
- command_e_2,
- command_e_3,
- command_e_4];
-command_e(doc) -> "Tests port_command/2 with errors".
%% port_command/2: badarg 1st arg
command_e_1(Config) when is_list(Config) ->
@@ -161,7 +178,6 @@ do_command_e_4(Program) ->
?line erlang:port_command(P, Data),
exit(survived).
-port_info(suite) -> [port_info1, port_info2].
%% Tests the port_info/1 BIF
port_info1(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 77f850d0fb..f7553e5815 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -25,12 +25,13 @@
%% process_info/1,2
%% register/2 (partially)
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(heap_binary_size, 64).
--export([all/1, spawn_with_binaries/1,
- t_exit_1/1, t_exit_2/1, t_exit_2_other/1, t_exit_2_other_normal/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, spawn_with_binaries/1,
+ t_exit_1/1, t_exit_2_other/1, t_exit_2_other_normal/1,
self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1,
t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1,
exit_and_timeout/1, exit_twice/1,
@@ -46,39 +47,67 @@
processes_large_tab/1, processes_default_tab/1, processes_small_tab/1,
processes_this_tab/1, processes_apply_trap/1,
processes_last_call_trap/1, processes_gc_trap/1,
- processes_term_proc_list/1, processes_bif/1,
- otp_7738/1, otp_7738_waiting/1, otp_7738_suspended/1,
+ processes_term_proc_list/1,
+ otp_7738_waiting/1, otp_7738_suspended/1,
otp_7738_resume/1]).
-export([prio_server/2, prio_client/2]).
--export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
-export([hangaround/2, processes_bif_test/0, do_processes/1,
processes_term_proc_list_test/1]).
-all(suite) ->
- [spawn_with_binaries, t_exit_1, t_exit_2,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [spawn_with_binaries, t_exit_1, {group, t_exit_2},
trap_exit_badarg, trap_exit_badarg_in_bif,
- t_process_info, process_info_other_msg, process_info_other_dist_msg,
- process_info_2_list,
- process_info_lock_reschedule, process_info_lock_reschedule2,
- process_status_exiting,
- bump_reductions, low_prio, yield, yield2, otp_4725, bad_register,
- garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size,
- spawn_opt_heap_size, otp_6237, processes_bif, otp_7738].
+ t_process_info, process_info_other_msg,
+ process_info_other_dist_msg, process_info_2_list,
+ process_info_lock_reschedule,
+ process_info_lock_reschedule2, process_status_exiting,
+ bump_reductions, low_prio, yield, yield2, otp_4725,
+ bad_register, garbage_collect, process_info_messages,
+ process_flag_badarg, process_flag_heap_size,
+ spawn_opt_heap_size, otp_6237, {group, processes_bif},
+ {group, otp_7738}].
+
+groups() ->
+ [{t_exit_2, [],
+ [t_exit_2_other, t_exit_2_other_normal, self_exit,
+ normal_suicide_exit, abnormal_suicide_exit,
+ t_exit_2_catch, exit_and_timeout, exit_twice]},
+ {processes_bif, [],
+ [processes_large_tab, processes_default_tab,
+ processes_small_tab, processes_this_tab,
+ processes_last_call_trap, processes_apply_trap,
+ processes_gc_trap, processes_term_proc_list]},
+ {otp_7738, [],
+ [otp_7738_waiting, otp_7738_suspended,
+ otp_7738_resume]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false),
+ Config.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(10)),
[{watchdog, Dog},{testcase, Func}|Config].
-fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-end_per_suite(Config) ->
- catch erts_debug:set_internal_state(available_internal_state, false),
- Config.
-
fun_spawn(Fun) ->
spawn_link(erlang, apply, [Fun, []]).
@@ -117,10 +146,6 @@ t_exit_1() ->
{'EXIT', Pid, Garbage} -> ok
end.
-t_exit_2(suite) -> [t_exit_2_other, t_exit_2_other_normal,
- self_exit, normal_suicide_exit,
- abnormal_suicide_exit, t_exit_2_catch,
- exit_and_timeout, exit_twice].
%% Tests exit/2 with a lot of data in the exit message.
t_exit_2_other(Config) when is_list(Config) ->
@@ -1227,17 +1252,6 @@ otp_6237_select_loop() ->
otp_6237_select_loop().
-processes_bif(doc) ->
- [];
-processes_bif(suite) ->
- [processes_large_tab,
- processes_default_tab,
- processes_small_tab,
- processes_this_tab,
- processes_last_call_trap,
- processes_apply_trap,
- processes_gc_trap,
- processes_term_proc_list].
-define(NoTestProcs, 10000).
-record(processes_bif_info, {min_start_reds,
@@ -1965,10 +1979,6 @@ processes_term_proc_list_test(MustChk) ->
?line erlang:system_flag(multi_scheduling, unblock),
?line as_expected.
-otp_7738(doc) ->
- [];
-otp_7738(suite) ->
- [otp_7738_waiting, otp_7738_suspended, otp_7738_resume].
otp_7738_waiting(doc) ->
[];
diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl
index 907204cf93..f0668dd287 100644
--- a/erts/emulator/test/pseudoknot_SUITE.erl
+++ b/erts/emulator/test/pseudoknot_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,29 @@
-module(pseudoknot_SUITE).
--export([all/1,test/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,test/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [test].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) -> [test].
test(Config) when is_list(Config) ->
statistics(runtime),
diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl
index 4bce347d9a..8f21b5a3b3 100644
--- a/erts/emulator/test/random_iolist.erl
+++ b/erts/emulator/test/random_iolist.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl
index 40ebf2bd21..2ac696b4c7 100644
--- a/erts/emulator/test/receive_SUITE.erl
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -21,21 +21,40 @@
%% Tests receive after.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
call_with_huge_message_queue/1,receive_in_between/1]).
--export([init_per_testcase/2,fin_per_testcase/2]).
+-export([init_per_testcase/2,end_per_testcase/2]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [call_with_huge_message_queue, receive_in_between].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-all(suite) ->
- [call_with_huge_message_queue,receive_in_between].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl
index fa77095efd..327d55fead 100644
--- a/erts/emulator/test/ref_SUITE.erl
+++ b/erts/emulator/test/ref_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,23 +19,44 @@
-module(ref_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2]).
-export([wrap_1/1]).
-export([loop_ref/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(_, Config) ->
?line Dog=test_server:timetrap(test_server:minutes(2)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_, Config) ->
+end_per_testcase(_, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(suite) -> [wrap_1].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [wrap_1].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
wrap_1(doc) -> "Check that refs don't wrap around easily.";
wrap_1(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl
index c03ee23b2e..d88df8d59d 100644
--- a/erts/emulator/test/register_SUITE.erl
+++ b/erts/emulator/test/register_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009. All Rights Reserved.
+%% Copyright Ericsson AB 2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -22,24 +22,43 @@
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%-compile(export_all).
--export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
-export([otp_8099/1]).
-define(DEFAULT_TIMEOUT, ?t:minutes(2)).
-all(doc) -> [];
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[otp_8099].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
[{watchdog, Dog}, {testcase, Case} | Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl
index b56c4ad0b0..4929031794 100644
--- a/erts/emulator/test/save_calls_SUITE.erl
+++ b/erts/emulator/test/save_calls_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,17 +19,36 @@
-module(save_calls_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([save_calls_1/1,dont_break_reductions/1]).
-export([do_bopp/1, do_bipp/0, do_bepp/0]).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[save_calls_1, dont_break_reductions].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
dont_break_reductions(suite) ->
[];
dont_break_reductions(doc) ->
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index 06442bfad6..1478bbeb52 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -30,10 +30,12 @@
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%-compile(export_all).
--export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2, end_per_suite/1]).
-export([equal/1,
few_low/1,
@@ -44,7 +46,7 @@
equal_with_high/1,
equal_with_high_max/1,
bound_process/1,
- scheduler_bind/1,
+
scheduler_bind_types/1,
cpu_topology/1,
update_cpu_info/1,
@@ -57,21 +59,35 @@
-define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)).
-all(doc) -> [];
-all(suite) ->
- [equal,
- few_low,
- many_low,
- equal_with_part_time_high,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [equal, few_low, many_low, equal_with_part_time_high,
equal_with_part_time_max,
- equal_and_high_with_part_time_max,
- equal_with_high,
- equal_with_high_max,
- bound_process,
- scheduler_bind,
- scheduler_suspend,
+ equal_and_high_with_part_time_max, equal_with_high,
+ equal_with_high_max, bound_process,
+ {group, scheduler_bind}, scheduler_suspend,
reader_groups].
+groups() ->
+ [{scheduler_bind, [],
+ [scheduler_bind_types, cpu_topology, update_cpu_info,
+ sct_cmd, sbt_cmd]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false),
+ Config.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
process_flag(priority, max),
@@ -79,15 +95,11 @@ init_per_testcase(Case, Config) when is_list(Config) ->
OkRes = ok,
[{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-end_per_suite(Config) ->
- catch erts_debug:set_internal_state(available_internal_state, false),
- Config.
-
-define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)).
-define(DEFAULT_TEST_REDS_PER_SCHED, 200000000).
@@ -247,12 +259,6 @@ bound_loop(NS, N, M, Sched) ->
Sched = erlang:system_info(scheduler_id),
bound_loop(NS, N-1, M, Sched).
-scheduler_bind(suite) ->
- [scheduler_bind_types,
- cpu_topology,
- update_cpu_info,
- sct_cmd,
- sbt_cmd].
-define(TOPOLOGY_A_CMD,
"+sct"
diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index 819aa34886..84352f78ad 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -19,24 +19,43 @@
-module(send_term_SUITE).
--export([all/1,basic/1]).
--export([init_per_testcase/2,fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,basic/1]).
+-export([init_per_testcase/2,end_per_testcase/2]).
-export([generate_external_terms_files/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
[basic].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
basic(Config) when is_list(Config) ->
Drv = "send_term_drv",
?line P = start_driver(Config, Drv),
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index 458275af81..57bc6ce08e 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,11 @@
-module(sensitive_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1,
meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1,
t_process_info/1,t_process_display/1,save_calls/1]).
@@ -34,14 +36,33 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(5)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
-all(suite) ->
- [stickiness,send_trace,recv_trace,proc_trace,call_trace,
- meta_trace,running_trace,gc_trace,seq_trace,
- t_process_info,t_process_display,save_calls].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [stickiness, send_trace, recv_trace, proc_trace,
+ call_trace, meta_trace, running_trace, gc_trace,
+ seq_trace, t_process_info, t_process_display,
+ save_calls].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
stickiness(Config) when is_list(Config) ->
?line {Tracer,Mref} = spawn_monitor(fun() ->
diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl
index e9103ca3c1..682a9d03fc 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,8 +30,9 @@
-define(DEFAULT_TIMEOUT_SECONDS, 120).
%-define(line_trace, 1).
--include("test_server.hrl").
--export([all/1]).
+-include_lib("test_server/include/test_server.hrl").
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
% Test cases
-export([xm_sig_order/1,
@@ -49,38 +50,48 @@
pending_exit_group_leader/1,
exit_before_pending_exit/1]).
--export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)),
available_internal_state(true),
?line [{testcase, Func},{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
?line Dog = ?config(watchdog, Config),
?line ?t:timetrap_cancel(Dog).
+init_per_suite(Config) ->
+ Config.
+
end_per_suite(_Config) ->
available_internal_state(true),
- erts_debug:set_internal_state(not_running_optimization, true),
+ catch erts_debug:set_internal_state(not_running_optimization, true),
available_internal_state(false).
-all(suite) ->
- [xm_sig_order,
- pending_exit_unlink_process,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [xm_sig_order, pending_exit_unlink_process,
pending_exit_unlink_dist_process,
- pending_exit_unlink_port,
- pending_exit_trap_exit,
- pending_exit_receive,
- pending_exit_trap_exit,
- pending_exit_gc,
- pending_exit_is_process_alive,
+ pending_exit_unlink_port, pending_exit_trap_exit,
+ pending_exit_receive, pending_exit_trap_exit,
+ pending_exit_gc, pending_exit_is_process_alive,
pending_exit_process_display,
pending_exit_process_info_1,
- pending_exit_process_info_2,
- pending_exit_group_leader,
+ pending_exit_process_info_2, pending_exit_group_leader,
exit_before_pending_exit].
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
xm_sig_order(doc) -> ["Test that exit signals and messages are received "
"in correct order"];
xm_sig_order(suite) -> [];
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index 898908c40f..b543491471 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -21,13 +21,14 @@
%% Tests the statistics/1 bif.
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
init_per_testcase/2,
- fin_per_testcase/2,
- wall_clock/1, wall_clock_zero_diff/1, wall_clock_update/1,
- runtime/1, runtime_zero_diff/1,
+ end_per_testcase/2,
+ wall_clock_zero_diff/1, wall_clock_update/1,
+ runtime_zero_diff/1,
runtime_update/1, runtime_diff/1,
- run_queue/1, run_queue_one/1,
+ run_queue_one/1,
reductions/1, reductions_big/1, garbage_collection/1, io/1,
badarg/1]).
@@ -35,24 +36,47 @@
-export([hog/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(_, Config) ->
?line Dog = test_server:timetrap(test_server:seconds(300)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_, Config) ->
+end_per_testcase(_, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(suite) -> [wall_clock, runtime, reductions, reductions_big, run_queue,
- garbage_collection, io, badarg].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group, wall_clock}, {group, runtime}, reductions,
+ reductions_big, {group, run_queue}, garbage_collection,
+ io, badarg].
+
+groups() ->
+ [{wall_clock, [],
+ [wall_clock_zero_diff, wall_clock_update]},
+ {runtime, [],
+ [runtime_zero_diff, runtime_update, runtime_diff]},
+ {run_queue, [], [run_queue_one]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%%% Testing statistics(wall_clock).
-wall_clock(suite) -> [wall_clock_zero_diff, wall_clock_update].
wall_clock_zero_diff(doc) ->
@@ -99,7 +123,6 @@ wall_clock_update1(0) ->
%%% Test statistics(runtime).
-runtime(suite) -> [runtime_zero_diff, runtime_update, runtime_diff].
runtime_zero_diff(doc) ->
"Tests that the difference between the times returned from two consectuitive "
@@ -225,7 +248,6 @@ reductions_big_loop() ->
%%% Tests of statistics(run_queue).
-run_queue(suite) -> [run_queue_one].
run_queue_one(doc) ->
"Tests that statistics(run_queue) returns 1 if we start a "
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index cd940f3ddf..0293341eac 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -30,23 +30,44 @@
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%-compile(export_all).
--export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]).
-define(DEFAULT_TIMEOUT, ?t:minutes(2)).
-all(doc) -> [];
-all(suite) -> [process_count, system_version, misc_smoke_tests, heap_size, wordsize].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [process_count, system_version, misc_smoke_tests,
+ heap_size, wordsize].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index 7b0d6d19fe..e4cfa56d88 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -22,35 +22,52 @@
-module(system_profile_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
system_profile_on_and_off/1,
runnable_procs/1,
runnable_ports/1,
scheduler/1
]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
--export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]).
+-export([profiler_process/1, ring_loop/1, port_echo_start/0,
+ list_load/0, run_load/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(default_timeout, ?t:minutes(1)).
init_per_testcase(_Case, Config) ->
?line Dog=?t:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-all(suite) ->
- %% Test specification on test suite level
- [system_profile_on_and_off,
- runnable_procs,
- runnable_ports,
- scheduler].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [system_profile_on_and_off, runnable_procs,
+ runnable_ports, scheduler].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%% No specification clause needed for an init function in a conf case!!!
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index 095e9dd1af..43dccc6ecb 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -29,14 +29,15 @@
%% now/0
%%
--export([all/1, univ_to_local/1, local_to_univ/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, univ_to_local/1, local_to_univ/1,
bad_univ_to_local/1, bad_local_to_univ/1,
consistency/1,
- now/1, now_unique/1, now_update/1, timestamp/1]).
+ now_unique/1, now_update/1, timestamp/1]).
-export([local_to_univ_utc/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-export([linear_time/1]).
@@ -54,10 +55,28 @@
-define(dst_timezone, 2).
-all(suite) -> [univ_to_local, local_to_univ,
- local_to_univ_utc,
- bad_univ_to_local, bad_local_to_univ,
- consistency, now, timestamp].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [univ_to_local, local_to_univ, local_to_univ_utc,
+ bad_univ_to_local, bad_local_to_univ, consistency,
+ {group, now}, timestamp].
+
+groups() ->
+ [{now, [], [now_unique, now_update]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
local_to_univ_utc(suite) ->
[];
@@ -283,7 +302,6 @@ repeating_timestamp_check(N) ->
%% Test now/0.
-now(suite) -> [now_unique, now_update].
%% Tests that successive calls to now/0 returns different values.
%% Also returns a comment string with the median difference between
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl
index 9ac5afcc45..6c421253af 100644
--- a/erts/emulator/test/timer_bif_SUITE.erl
+++ b/erts/emulator/test/timer_bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,7 +19,9 @@
-module(timer_bif_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,end_per_suite/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2]).
-export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1,
cancel_timer_1/1,
start_timer_big/1, send_after_big/1,
@@ -27,7 +29,7 @@
read_timer_trivial/1, read_timer/1,
cleanup/1, evil_timers/1, registered_process/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:seconds(30)),
@@ -37,19 +39,35 @@ init_per_testcase(_Case, Config) ->
end,
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
+init_per_suite(Config) ->
+ Config.
+
end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false).
-all(suite) ->
- [start_timer_1, send_after_1, send_after_2, cancel_timer_1,
- start_timer_e, send_after_e, cancel_timer_e,
- start_timer_big, send_after_big, read_timer_trivial, read_timer,
- cleanup, evil_timers, registered_process].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [start_timer_1, send_after_1, send_after_2,
+ cancel_timer_1, start_timer_e, send_after_e,
+ cancel_timer_e, start_timer_big, send_after_big,
+ read_timer_trivial, read_timer, cleanup, evil_timers,
+ registered_process].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
start_timer_1(doc) -> ["Basic start_timer/3 functionality"];
start_timer_1(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index e9713fcf0f..d200fdaf4c 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -23,7 +23,8 @@
%%% Tests the trace BIF.
%%%
--export([all/1, receive_trace/1, self_send/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, receive_trace/1, self_send/1,
timeout_trace/1, send_trace/1,
procs_trace/1, dist_procs_trace/1,
suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
@@ -35,22 +36,39 @@
system_monitor_large_heap_1/1, system_monitor_large_heap_2/1,
bad_flag/1, trace_delivered/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%%% Internal exports
-export([process/1]).
-all(suite) ->
- [cpu_timestamp, receive_trace, self_send, timeout_trace, send_trace,
- procs_trace, dist_procs_trace,
- suspend, mutual_suspend, suspend_exit, suspender_exit,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [cpu_timestamp, receive_trace, self_send, timeout_trace,
+ send_trace, procs_trace, dist_procs_trace, suspend,
+ mutual_suspend, suspend_exit, suspender_exit,
suspend_system_limit, suspend_opts, suspend_waiting,
- new_clear, existing_clear,
- set_on_spawn, set_on_first_spawn,
- system_monitor_args, more_system_monitor_args,
- system_monitor_long_gc_1, system_monitor_long_gc_2,
- system_monitor_large_heap_1, system_monitor_large_heap_2,
- bad_flag, trace_delivered].
+ new_clear, existing_clear, set_on_spawn,
+ set_on_first_spawn, system_monitor_args,
+ more_system_monitor_args, system_monitor_long_gc_1,
+ system_monitor_long_gc_2, system_monitor_large_heap_1,
+ system_monitor_large_heap_2, bad_flag, trace_delivered].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%% No longer testing anything, just reporting whether cpu_timestamp
diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl
index 3f91f8dc08..263db065b3 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,24 +19,44 @@
-module(trace_bif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1]).
--export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, trace_bif_local/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
+-export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1,
+ trace_bif_local/1,
trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1,
trace_info_old_code/1]).
-export([bif_process/0]).
-all(suite) ->
- case test_server:is_native(?MODULE) of
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(trace_bif_SUITE) of
true -> [not_run];
false ->
[trace_bif, trace_bif_timestamp, trace_on_and_off,
- trace_bif_local, trace_bif_timestamp_local,
+ trace_bif_local, trace_bif_timestamp_local,
trace_bif_return, trace_info_old_code]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl
index 07aa7c8d8d..55d9b2b288 100644
--- a/erts/emulator/test/trace_call_count_SUITE.erl
+++ b/erts/emulator/test/trace_call_count_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -42,7 +42,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-endif.
-ifdef(debug).
@@ -62,7 +62,9 @@ config(priv_dir,_) ->
".".
-else.
%% When run in test server.
--export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2, not_run/1]).
-export([basic/1, on_and_off/1, info/1,
pause_and_restart/1, combo/1]).
@@ -70,7 +72,7 @@ init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:seconds(30)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]),
erlang:trace_pattern(on_load, false, [local,meta,call_count]),
erlang:trace(all, false, [all]),
@@ -78,15 +80,31 @@ fin_per_testcase(_Case, Config) ->
test_server:timetrap_cancel(Dog),
ok.
-all(doc) ->
- ["Test call count tracing of local function calls."];
-all(suite) ->
- case test_server:is_native(?MODULE) of
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(trace_call_count_SUITE) of
true -> [not_run];
- false -> [basic, on_and_off, info,
- pause_and_restart, combo]
+ false ->
+ [basic, on_and_off, info, pause_and_restart, combo]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl
index 7bc91addde..8bf66b7177 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -57,12 +57,15 @@
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% When run in test server.
--export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2, not_run/1]).
-export([basic/1, on_and_off/1, info/1,
- pause_and_restart/1, scheduling/1, called_function/1, combo/1, bif/1, nif/1]).
+ pause_and_restart/1, scheduling/1, called_function/1, combo/1,
+ bif/1, nif/1]).
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:seconds(400)),
@@ -71,7 +74,7 @@ init_per_testcase(_Case, Config) ->
timer:now_diff(now(),now()),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]),
erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]),
erlang:trace(all, false, [all]),
@@ -79,15 +82,32 @@ fin_per_testcase(_Case, Config) ->
test_server:timetrap_cancel(Dog),
ok.
-all(doc) ->
- ["Test call count tracing of local function calls."];
-all(suite) ->
- case test_server:is_native(?MODULE) of
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(trace_call_time_SUITE) of
true -> [not_run];
- false -> [basic, on_and_off, info,
- pause_and_restart, scheduling, combo, bif, nif, called_function]
+ false ->
+ [basic, on_and_off, info, pause_and_restart, scheduling,
+ combo, bif, nif, called_function]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 24005774ba..0235f624ce 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -45,7 +45,7 @@
-export([config/2]).
-define(DEFAULT_RECEIVE_TIMEOUT, 1000).
-else.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(DEFAULT_RECEIVE_TIMEOUT, infinity).
-endif.
@@ -68,7 +68,8 @@ config(priv_dir,_) ->
%%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([all/1, basic/1, bit_syntax/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, basic/1, bit_syntax/1,
return/1, on_and_off/1, stack_grow/1,info/1, delete/1,
exception/1, exception_apply/1,
exception_function/1, exception_apply_function/1,
@@ -79,34 +80,51 @@ config(priv_dir,_) ->
exception_meta_nocatch/1, exception_meta_nocatch_apply/1,
exception_meta_nocatch_function/1,
exception_meta_nocatch_apply_function/1,
- init_per_testcase/2, fin_per_testcase/2]).
+ init_per_testcase/2, end_per_testcase/2]).
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:minutes(2)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
shutdown(),
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(doc) ->
- ["Test tracing of local function calls and return traces."];
-all(suite) ->
- case test_server:is_native(?MODULE) of
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(trace_local_SUITE) of
true -> [not_run];
- false -> [basic, bit_syntax, return, on_and_off, stack_grow, info, delete,
- exception, exception_apply,
- exception_function, exception_apply_function,
- exception_nocatch, exception_nocatch_apply,
- exception_nocatch_function,
- exception_nocatch_apply_function,
- exception_meta, exception_meta_apply,
- exception_meta_function, exception_meta_apply_function,
- exception_meta_nocatch, exception_meta_nocatch_apply,
- exception_meta_nocatch_function,
- exception_meta_nocatch_apply_function]
+ false ->
+ [basic, bit_syntax, return, on_and_off, stack_grow,
+ info, delete, exception, exception_apply,
+ exception_function, exception_apply_function,
+ exception_nocatch, exception_nocatch_apply,
+ exception_nocatch_function,
+ exception_nocatch_apply_function, exception_meta,
+ exception_meta_apply, exception_meta_function,
+ exception_meta_apply_function, exception_meta_nocatch,
+ exception_meta_nocatch_apply,
+ exception_meta_nocatch_function,
+ exception_meta_nocatch_apply_function]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl
index d84cb3cdf2..666bd60511 100644
--- a/erts/emulator/test/trace_meta_SUITE.erl
+++ b/erts/emulator/test/trace_meta_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -45,7 +45,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-endif.
-ifdef(debug).
@@ -65,7 +65,9 @@ config(priv_dir,_) ->
".".
-else.
%% When run in test server.
--export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2, not_run/1]).
-export([basic/1, return/1, on_and_off/1, stack_grow/1,
info/1, tracer/1, combo/1, nosilent/1]).
@@ -73,19 +75,36 @@ init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(test_server:minutes(5)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
shutdown(),
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(doc) ->
- ["Test meta tracing of local function calls and return trace."];
-all(suite) ->
- case test_server:is_native(?MODULE) of
- true -> [not_run];
- false -> [basic, return, on_and_off, stack_grow,
- info, tracer, combo, nosilent]
- end.
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+case test_server:is_native(trace_meta_SUITE) of
+ true -> [not_run];
+ false ->
+ [basic, return, on_and_off, stack_grow, info, tracer,
+ combo, nosilent]
+end.
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl
index 587cc08979..a52ee15e0e 100644
--- a/erts/emulator/test/trace_nif_SUITE.erl
+++ b/erts/emulator/test/trace_nif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009. All Rights Reserved.
+%% Copyright Ericsson AB 2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,9 +19,10 @@
-module(trace_nif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2]).
-export([trace_nif/1,
trace_nif_timestamp/1,
trace_nif_local/1,
@@ -32,19 +33,33 @@
-export([nif_process/0, nif/0, nif/1]).
-all(suite) ->
- case test_server:is_native(?MODULE) of
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ case test_server:is_native(trace_nif_SUITE) of
true -> [not_run];
false ->
- [trace_nif,
- trace_nif_timestamp,
- trace_nif_local,
- trace_nif_meta,
- trace_nif_timestamp_local,
- trace_nif_return
- ]
+ [trace_nif, trace_nif_timestamp, trace_nif_local,
+ trace_nif_meta, trace_nif_timestamp_local,
+ trace_nif_return]
end.
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index 5febe177f9..d94fc0aa20 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,7 +20,9 @@
-module(trace_port_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
call_trace/1,
return_trace/1,
send/1,
@@ -34,29 +36,42 @@
gc/1,
default_tracer/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-test_cases() ->
- [call_trace,
- return_trace,
- send,
- receive_trace,
- process_events,
- schedule,
- fake_schedule,
+test_cases() ->
+ [call_trace, return_trace, send, receive_trace,
+ process_events, schedule, fake_schedule,
fake_schedule_after_register,
fake_schedule_after_getting_linked,
- fake_schedule_after_getting_unlinked,
- gc,
+ fake_schedule_after_getting_unlinked, gc,
default_tracer].
-all(suite) -> test_cases().
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_cases().
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:seconds(30)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index c4edb16d68..c1f171d9b5 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -17,11 +17,13 @@
%% %CopyrightEnd%
%%
-module(tuple_SUITE).
--export([all/1, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ t_size/1, t_tuple_size/1, t_element/1, t_setelement/1,
t_list_to_tuple/1, t_tuple_to_list/1,
t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1,
build_and_match/1, tuple_with_case/1, tuple_in_guard/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% Tests tuples and the BIFs:
%%
@@ -33,13 +35,30 @@
%% make_tuple/2
%%
-all(suite) ->
- [build_and_match, t_size, t_tuple_size,
- t_list_to_tuple, t_tuple_to_list,
- t_element, t_setelement, t_make_tuple_2,
- t_make_tuple_3, t_append_element,
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [build_and_match, t_size, t_tuple_size, t_list_to_tuple,
+ t_tuple_to_list, t_element, t_setelement,
+ t_make_tuple_2, t_make_tuple_3, t_append_element,
tuple_with_case, tuple_in_guard].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
build_and_match(Config) when is_list(Config) ->
?line {} = id({}),
?line {1} = id({1}),
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index 67d2b288a2..9637ecd87e 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -29,10 +29,12 @@
%-define(line_trace, 1).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%-compile(export_all).
--export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, init_per_testcase/2,
+ end_per_testcase/2]).
-export([schedulers_alive/1, node_container_refc_check/1,
long_timers/1, pollset_size/1,
@@ -40,19 +42,33 @@
-define(DEFAULT_TIMEOUT, ?t:minutes(5)).
-all(doc) -> [];
-all(suite) ->
- [schedulers_alive,
- node_container_refc_check,
- long_timers,
- pollset_size,
- check_io_debug].
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [schedulers_alive, node_container_refc_check,
+ long_timers, pollset_size, check_io_debug].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) when is_list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.