aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
authorSverker Eriksson <[email protected]>2010-01-13 11:35:13 +0000
committerErlang/OTP <[email protected]>2010-01-13 14:58:31 +0100
commitbcf62deb7b8534b00ce69c977466a009252ee8a5 (patch)
tree237405be3ddf2b984399926f68856ad7036631aa /erts/emulator
parent405de8c986fd22c05f398036edac809e98149292 (diff)
downloadotp-bcf62deb7b8534b00ce69c977466a009252ee8a5.tar.gz
otp-bcf62deb7b8534b00ce69c977466a009252ee8a5.tar.bz2
otp-bcf62deb7b8534b00ce69c977466a009252ee8a5.zip
OTP-8240 Improved GC performance after BIF/NIF call when a lot of heap
fragments was created. This will mainly benefit NIFs that return large compound terms.
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/beam/beam_emu.c38
-rw-r--r--erts/emulator/beam/erl_arith.c43
-rw-r--r--erts/emulator/beam/erl_bif_info.c17
-rw-r--r--erts/emulator/beam/erl_debug.c14
-rw-r--r--erts/emulator/beam/erl_gc.c206
-rw-r--r--erts/emulator/beam/erl_message.c24
-rw-r--r--erts/emulator/beam/erl_message.h23
-rw-r--r--erts/emulator/beam/erl_process.h30
-rw-r--r--erts/emulator/beam/erl_vm.h74
-rw-r--r--erts/emulator/beam/external.c165
-rw-r--r--erts/emulator/beam/global.h11
-rw-r--r--erts/emulator/beam/utils.c60
-rw-r--r--erts/emulator/test/binary_SUITE.erl11
-rw-r--r--erts/emulator/test/fun_SUITE.erl18
-rw-r--r--erts/emulator/test/statistics_SUITE.erl21
-rw-r--r--erts/emulator/test/trace_SUITE.erl77
16 files changed, 453 insertions, 379 deletions
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 4ebb8853be..13757b7d1c 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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%
*/
@@ -286,6 +286,15 @@ extern int count_instructions;
#endif
+#ifdef FORCE_HEAP_FRAGS
+# define HEAP_SPACE_VERIFIED(Words) do { \
+ c_p->space_verified = (Words); \
+ c_p->space_verified_from = HTOP; \
+ }while(0)
+#else
+# define HEAP_SPACE_VERIFIED(Words) ((void)0)
+#endif
+
#define PRE_BIF_SWAPOUT(P) \
HEAP_TOP((P)) = HTOP; \
(P)->stop = E; \
@@ -411,6 +420,7 @@ extern int count_instructions;
r(0) = reg[0]; \
SWAPIN; \
} \
+ HEAP_SPACE_VERIFIED(need); \
} while (0)
@@ -432,6 +442,7 @@ extern int count_instructions;
r(0) = reg[0]; \
SWAPIN; \
} \
+ HEAP_SPACE_VERIFIED(need); \
} while (0)
/*
@@ -456,6 +467,7 @@ extern int count_instructions;
Extra = reg[Live]; \
SWAPIN; \
} \
+ HEAP_SPACE_VERIFIED(need); \
} while (0)
#ifdef HYBRID
@@ -832,6 +844,7 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \
LIGHT_SWAPIN; \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
else { Store(_result, Dst); } \
} while (0)
@@ -845,6 +858,7 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \
LIGHT_SWAPIN; \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
else { Store(_result, Dst); } \
} while (0)
@@ -859,6 +873,7 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \
LIGHT_SWAPIN; \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
else { Store(_result, Dst); } \
} while (0)
@@ -873,9 +888,12 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_binary_all_2(c_p, _mb); \
LIGHT_SWAPIN; \
+ HEAP_SPACE_VERIFIED(0); \
ASSERT(is_value(_result)); \
Store(_result, Dst); \
- } else { Fail; } \
+ } else { \
+ HEAP_SPACE_VERIFIED(0); \
+ Fail; } \
} while (0)
#define BsSkipBits2(Ms, Bits, Unit, Fail) \
@@ -1360,6 +1378,7 @@ void process_main(void)
*/
c_p->cp = 0;
CHECK_TERM(r(0));
+ HEAP_SPACE_VERIFIED(0);
Goto(*I);
}
@@ -2379,6 +2398,7 @@ void process_main(void)
if (is_big(tmp_arg1)) {
HTOP += bignum_header_arity(*HTOP) + 1;
}
+ HEAP_SPACE_VERIFIED(0);
if (is_nil(tmp_arg1)) {
/*
* This result must have been only slight larger
@@ -3225,6 +3245,7 @@ apply_bif_or_nif_epilogue:
sb->orig = new_binary;
new_binary = make_binary(sb);
}
+ HEAP_SPACE_VERIFIED(0);
StoreBifResult(2, new_binary);
} else {
Binary* bptr;
@@ -3712,6 +3733,7 @@ apply_bif_or_nif_epilogue:
*dst = *ms;
*HTOP = HEADER_BIN_MATCHSTATE(slots);
HTOP += wordsneeded;
+ HEAP_SPACE_VERIFIED(0);
StoreResult(make_matchstate(dst), Arg(3));
}
} else if (is_binary_header(header)) {
@@ -3725,6 +3747,7 @@ apply_bif_or_nif_epilogue:
#endif
result = erts_bs_start_match_2(c_p, tmp_arg1, slots);
HTOP = HEAP_TOP(c_p);
+ HEAP_SPACE_VERIFIED(0);
if (is_non_value(result)) {
ClauseFail();
} else {
@@ -3917,6 +3940,7 @@ apply_bif_or_nif_epilogue:
TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
_result = uint_to_big((Uint) _integer, HTOP);
HTOP += BIG_UINT_HEAP_SIZE;
+ HEAP_SPACE_VERIFIED(0);
}
#endif
StoreBifResult(2, _result);
@@ -3982,6 +4006,7 @@ apply_bif_or_nif_epilogue:
LIGHT_SWAPOUT;
result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb);
LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
if (is_non_value(result)) {
ClauseFail();
}
@@ -4009,6 +4034,7 @@ apply_bif_or_nif_epilogue:
LIGHT_SWAPOUT;
result = erts_bs_get_integer_2(c_p, size, flags, mb);
LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
if (is_non_value(result)) {
ClauseFail();
}
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index b692832677..126ec7cc73 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -1,19 +1,19 @@
/*
* %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
* 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%
*/
@@ -50,18 +50,16 @@ static ERTS_INLINE void maybe_shrink(Process* p, Eterm* hp, Eterm res, Uint allo
if (is_immed(res)) {
if (p->heap <= hp && hp < p->htop) {
p->htop = hp;
-#if defined(CHECK_FOR_HOLES)
- } else {
- erts_arith_shrink(p, hp);
-#endif
+ }
+ else {
+ erts_heap_frag_shrink(p, hp);
}
} else if ((actual = bignum_header_arity(*hp)+1) < alloc) {
if (p->heap <= hp && hp < p->htop) {
p->htop = hp+actual;
-#if defined(CHECK_FOR_HOLES)
- } else {
- erts_arith_shrink(p, hp+actual);
-#endif
+ }
+ else {
+ erts_heap_frag_shrink(p, hp+actual);
}
}
}
@@ -397,12 +395,11 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
need_heap = BIG_NEED_SIZE(sz);
hp = HAlloc(p, need_heap);
res = big_plus(arg1, arg2, hp);
+ maybe_shrink(p, hp, res, need_heap);
if (is_nil(res)) {
- erts_arith_shrink(p, hp);
p->freason = SYSTEM_LIMIT;
return THE_NON_VALUE;
}
- maybe_shrink(p, hp, res, need_heap);
return res;
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
if (big_to_double(arg1, &f1.fd) < 0) {
@@ -533,12 +530,11 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
need_heap = BIG_NEED_SIZE(sz);
hp = HAlloc(p, need_heap);
res = big_minus(arg1, arg2, hp);
+ maybe_shrink(p, hp, res, need_heap);
if (is_nil(res)) {
- erts_arith_shrink(p, hp);
p->freason = SYSTEM_LIMIT;
return THE_NON_VALUE;
}
- maybe_shrink(p, hp, res, need_heap);
return res;
default:
goto badarith;
@@ -731,12 +727,11 @@ erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
* the absolute value of the other is > 1.
*/
+ maybe_shrink(p, hp, res, need_heap);
if (is_nil(res)) {
- erts_arith_shrink(p, hp);
p->freason = SYSTEM_LIMIT;
return THE_NON_VALUE;
- }
- maybe_shrink(p, hp, res, need_heap);
+ }
return res;
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
if (big_to_double(arg1, &f1.fd) < 0) {
@@ -956,12 +951,11 @@ erts_int_div(Process* p, Eterm arg1, Eterm arg2)
need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
hp = HAlloc(p, need);
arg1 = big_div(arg1, arg2, hp);
+ maybe_shrink(p, hp, arg1, need);
if (is_nil(arg1)) {
- erts_arith_shrink(p, hp);
p->freason = SYSTEM_LIMIT;
return THE_NON_VALUE;
}
- maybe_shrink(p, hp, arg1, need);
}
return arg1;
default:
@@ -1004,12 +998,11 @@ erts_int_rem(Process* p, Eterm arg1, Eterm arg2)
Eterm* hp = HAlloc(p, need);
arg1 = big_rem(arg1, arg2, hp);
+ maybe_shrink(p, hp, arg1, need);
if (is_nil(arg1)) {
- erts_arith_shrink(p, hp);
p->freason = SYSTEM_LIMIT;
return THE_NON_VALUE;
}
- maybe_shrink(p, hp, arg1, need);
}
return arg1;
default:
@@ -1147,7 +1140,7 @@ trim_heap(Process* p, Eterm* hp, Eterm res)
* a garbage collection if there is insufficient heap space.
*/
-#define erts_arith_shrink horrible error
+#define erts_heap_frag_shrink horrible error
#define maybe_shrink horrible error
Eterm
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 60216aa8e4..b2f81b6861 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -1,19 +1,19 @@
/*
* %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
* 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%
*/
@@ -3131,6 +3131,13 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)) {
BIF_RET(am_true);
}
+ else if (ERTS_IS_ATOM_STR("force_heap_frags", BIF_ARG_1)) {
+#ifdef FORCE_HEAP_FRAGS
+ BIF_RET(am_true);
+#else
+ BIF_RET(am_false);
+#endif
+ }
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index 34ce87bc5d..e5c3c76fdd 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -1,19 +1,19 @@
/*
* %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
* 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%
*/
@@ -344,7 +344,7 @@ void erts_check_for_holes(Process* p)
if (hf == p->last_mbuf) {
break;
}
- check_memory(hf->mem, hf->mem+hf->size);
+ check_memory(hf->mem, hf->mem+hf->used_size);
}
p->last_mbuf = MBUF(p);
}
@@ -386,7 +386,7 @@ void erts_check_heap(Process *p)
}
while (bp) {
- erts_check_memory(p,bp->mem,bp->mem + bp->size);
+ erts_check_memory(p,bp->mem,bp->mem + bp->used_size);
bp = bp->next;
}
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 6945317e65..363f956b58 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1,19 +1,19 @@
/*
* %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
* compliance with the License. You should have received a copy of the
* Erlang Public License along with this software. If not, it can be
* retrieved online at http://www.erlang.org/.
- *
+ *
* Software distributed under the License is distributed on an "AS IS"
* basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
* the License for the specific language governing rights and limitations
* under the License.
- *
+ *
* %CopyrightEnd%
*/
#ifdef HAVE_CONFIG_H
@@ -961,12 +961,13 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size);
} else {
Eterm* n_hp = n_heap;
+ Eterm* ptr;
+ Eterm val;
+ Eterm gval;
while (n_hp != n_htop) {
- Eterm* ptr;
- Eterm val;
- Eterm gval = *n_hp;
-
+ ASSERT(n_hp < n_htop);
+ gval = *n_hp;
switch (primary_tag(gval)) {
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
@@ -1402,68 +1403,6 @@ remove_message_buffers(Process* p)
}
}
-/*
- * Go through one root set array, move everything that it is one of the
- * heap fragments to our new heap.
- */
-static Eterm*
-collect_root_array(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
-{
- ErlHeapFragment* qb;
- Eterm gval;
- Eterm* ptr;
- Eterm val;
-
- ASSERT(p->htop != NULL);
- while (nobj--) {
- gval = *objv;
-
- switch (primary_tag(gval)) {
-
- case TAG_PRIMARY_BOXED: {
- ptr = boxed_val(gval);
- val = *ptr;
- if (IS_MOVED(val)) {
- ASSERT(is_boxed(val));
- *objv++ = val;
- } else {
- for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
- MOVE_BOXED(ptr,val,n_htop,objv);
- break;
- }
- }
- objv++;
- }
- break;
- }
-
- case TAG_PRIMARY_LIST: {
- ptr = list_val(gval);
- val = *ptr;
- if (is_non_value(val)) {
- *objv++ = ptr[1];
- } else {
- for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
- MOVE_CONS(ptr,val,n_htop,objv);
- break;
- }
- }
- objv++;
- }
- break;
- }
-
- default: {
- objv++;
- break;
- }
- }
- }
- return n_htop;
-}
-
#ifdef HARDDEBUG
/*
@@ -1707,11 +1646,13 @@ sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
static Eterm*
sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
{
- while (n_hp != n_htop) {
- Eterm* ptr;
- Eterm val;
- Eterm gval = *n_hp;
+ Eterm* ptr;
+ Eterm val;
+ Eterm gval;
+ while (n_hp != n_htop) {
+ ASSERT(n_hp < n_htop);
+ gval = *n_hp;
switch (primary_tag(gval)) {
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
@@ -1820,6 +1761,35 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
}
/*
+ * Move an area (heap fragment) by sweeping over it and set move markers.
+ */
+static Eterm*
+move_one_area(Eterm* n_htop, char* src, Uint src_size)
+{
+ Eterm* ptr = (Eterm*) src;
+ Eterm* end = ptr + src_size/sizeof(Eterm);
+ Eterm dummy_ref;
+
+ while (ptr != end) {
+ Eterm val;
+ ASSERT(ptr < end);
+ val = *ptr;
+ ASSERT(val != ERTS_HOLE_MARKER);
+ if (is_header(val)) {
+ ASSERT(ptr + header_arity(val) < end);
+ MOVE_BOXED(ptr, val, n_htop, &dummy_ref);
+ }
+ else { /* must be a cons cell */
+ ASSERT(ptr+1 < end);
+ MOVE_CONS(ptr, val, n_htop, &dummy_ref);
+ ptr += 2;
+ }
+ }
+
+ return n_htop;
+}
+
+/*
* Collect heap fragments and check that they point in the correct direction.
*/
@@ -1830,7 +1800,6 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
ErlHeapFragment* qb;
char* frag_begin;
Uint frag_size;
- ErlMessage* mp;
/*
* We don't allow references to a heap fragments from the stack, heap,
@@ -1845,65 +1814,44 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
#endif
/*
- * Go through the subset of the root set that is allowed to
- * reference data in heap fragments and move data from heap fragments
- * to our new heap.
- */
-
- if (nobj != 0) {
- n_htop = collect_root_array(p, n_htop, objv, nobj);
- }
- if (is_not_immed(p->fvalue)) {
- n_htop = collect_root_array(p, n_htop, &p->fvalue, 1);
- }
- if (is_not_immed(p->ftrace)) {
- n_htop = collect_root_array(p, n_htop, &p->ftrace, 1);
- }
- if (is_not_immed(p->seq_trace_token)) {
- n_htop = collect_root_array(p, n_htop, &p->seq_trace_token, 1);
- }
- if (is_not_immed(p->group_leader)) {
- n_htop = collect_root_array(p, n_htop, &p->group_leader, 1);
- }
-
- /*
- * Go through the message queue, move everything that is in one of the
- * heap fragments to our new heap.
- */
-
- for (mp = p->msg.first; mp != NULL; mp = mp->next) {
- /*
- * In most cases, mp->data.attached points to a heap fragment which is
- * self-contained and we will copy it to the heap at the
- * end of the GC to avoid scanning it.
- *
- * In a few cases, however, such as in process_info(Pid, messages)
- * and trace_delivered/1, a new message points to a term that has
- * been allocated by HAlloc() and mp->data.attached is NULL. Therefore
- * we need this loop.
- */
- if (mp->data.attached == NULL) {
- n_htop = collect_root_array(p, n_htop, mp->m, 2);
- }
- }
-
- /*
- * Now all references in the root set point to the new heap. However,
- * many references on the new heap point to heap fragments.
- */
-
+ * Move the heap fragments to the new heap. Note that no GC is done on
+ * the heap fragments. Any garbage will thus be moved as well and survive
+ * until next GC.
+ */
qb = MBUF(p);
- while (qb != NULL) {
- frag_begin = (char *) qb->mem;
- frag_size = qb->size * sizeof(Eterm);
+ while (qb != NULL) {
+ frag_size = qb->used_size * sizeof(Eterm);
if (frag_size != 0) {
- n_htop = sweep_one_area(n_hstart, n_htop, frag_begin, frag_size);
+ frag_begin = (char *) qb->mem;
+ n_htop = move_one_area(n_htop, frag_begin, frag_size);
}
qb = qb->next;
}
return n_htop;
}
+#ifdef DEBUG
+static Eterm follow_moved(Eterm term)
+{
+ Eterm* ptr;
+ switch (primary_tag(term)) {
+ case TAG_PRIMARY_IMMED1:
+ break;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(term);
+ if (IS_MOVED(*ptr)) term = *ptr;
+ break;
+ case TAG_PRIMARY_LIST:
+ ptr = list_val(term);
+ if (is_non_value(ptr[0])) term = ptr[1];
+ break;
+ default:
+ abort();
+ }
+ return term;
+}
+#endif
+
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
@@ -1932,7 +1880,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
}
ASSERT((is_nil(p->seq_trace_token) ||
- is_tuple(p->seq_trace_token) ||
+ is_tuple(follow_moved(p->seq_trace_token)) ||
is_atom(p->seq_trace_token)));
if (is_not_immed(p->seq_trace_token)) {
roots[n].v = &p->seq_trace_token;
@@ -1944,7 +1892,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
is_internal_pid(p->tracer_proc) ||
is_internal_port(p->tracer_proc));
- ASSERT(is_pid(p->group_leader));
+ ASSERT(is_pid(follow_moved(p->group_leader)));
if (is_not_immed(p->group_leader)) {
roots[n].v = &p->group_leader;
roots[n].sz = 1;
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 81fbdfbd5a..a056fce0c5 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -1,19 +1,19 @@
/*
* %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
* 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%
*/
/*
@@ -114,12 +114,8 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
nbp = (ErlHeapFragment*) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP_FRAG,
(void *) bp,
- (sizeof(ErlHeapFragment)
- - sizeof(Eterm)
- + bp->size*sizeof(Eterm)),
- (sizeof(ErlHeapFragment)
- - sizeof(Eterm)
- + size*sizeof(Eterm)));
+ ERTS_HEAP_FRAG_SIZE(bp->size),
+ ERTS_HEAP_FRAG_SIZE(size));
if (bp != nbp) {
Uint off_sz = size < nbp->size ? size : nbp->size;
Eterm *sp = &bp->mem[0];
@@ -140,7 +136,7 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
#endif
}
nbp->size = size;
-
+ nbp->used_size = size;
#ifdef HARD_DEBUG
for (i = 0; i < brefs_size; i++)
@@ -175,9 +171,7 @@ free_message_buffer(ErlHeapFragment* bp)
erts_cleanup_offheap(&bp->off_heap);
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG,
(void *) bp,
- (sizeof(ErlHeapFragment)
- - sizeof(Eterm)
- + bp->size*sizeof(Eterm)));
+ ERTS_HEAP_FRAG_SIZE(bp->size));
}
static ERTS_INLINE void
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index f14f14a586..5cf7c209bd 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -1,19 +1,19 @@
/*
* %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
* 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%
*/
@@ -50,19 +50,10 @@ struct erl_heap_fragment {
ErlHeapFragment* next; /* Next heap fragment */
ErlOffHeap off_heap; /* Offset heap data. */
unsigned size; /* Size in words of mem */
+ unsigned used_size; /* With terms to be moved to heap by GC */
Eterm mem[1]; /* Data */
};
-#define ERTS_SET_MBUF_HEAP_END(BP, HENDP) \
-do { \
- unsigned real_size__ = (BP)->size; \
- ASSERT((BP)->mem <= (HENDP) && (HENDP) <= (BP)->mem + real_size__); \
- (BP)->size = (HENDP) - (BP)->mem; \
- /* We do not reallocate since buffer *might* be moved. */ \
- /* FIXME: Memory count is wrong, but at least it's almost */ \
- /* right... */ \
-} while (0)
-
typedef struct erl_mesg {
struct erl_mesg* next; /* Next message */
union {
@@ -196,10 +187,12 @@ do { \
#define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \
(sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm))
+
#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \
do { \
(HEAP_FRAG_P)->next = NULL; \
(HEAP_FRAG_P)->size = (DATA_WORDS); \
+ (HEAP_FRAG_P)->used_size = (DATA_WORDS); \
(HEAP_FRAG_P)->off_heap.mso = NULL; \
(HEAP_FRAG_P)->off_heap.funs = NULL; \
(HEAP_FRAG_P)->off_heap.externals = NULL; \
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 7597eb5e31..1f841b2113 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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%
*/
@@ -654,6 +654,11 @@ struct process {
* heap fragments.
*/
#endif
+
+#ifdef FORCE_HEAP_FRAGS
+ Uint space_verified; /* Avoid HAlloc forcing heap fragments when */
+ Eterm* space_verified_from; /* we rely on available heap space (TestHeap) */
+#endif
};
#ifdef CHECK_FOR_HOLES
@@ -738,7 +743,20 @@ typedef struct {
#define KILL_CATCHES(p) (p)->catches = -1
-void erts_arith_shrink(Process* p, Eterm* hp);
+/* Shrink heap fragment from _last_ HAlloc.
+*/
+ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp);
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp)
+{
+ ErlHeapFragment* hf = MBUF(p);
+
+ ASSERT(hf!=NULL && (hp - hf->mem < (unsigned long)hf->size));
+
+ hf->used_size = hp - hf->mem;
+}
+#endif /* inline */
+
Eterm* erts_heap_alloc(Process* p, Uint need);
#ifdef CHECK_FOR_HOLES
Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 4d8315ab95..d8d6246cfd 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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%
*/
@@ -22,6 +22,13 @@
/* #define ERTS_OPCODE_COUNTER_SUPPORT */
+/* FORCE_HEAP_FRAGS:
+ * Debug provocation to make HAlloc always create heap fragments (if allowed)
+ * even if there is room on heap.
+ */
+/* #define FORCE_HEAP_FRAGS */
+
+
#if defined(HYBRID)
/* # define CHECK_FOR_HOLES */
#endif
@@ -70,6 +77,7 @@
&& (P) == (P)->scheduler_data->match_pseudo_process) \
|| erts_is_system_blocked(0))
+
#ifdef DEBUG
/*
* Debug HAlloc that initialize all memory to bad things.
@@ -80,55 +88,43 @@
VERBOSE(DEBUG_ALLOCATION,("HAlloc @ 0x%08lx (%d) %s:%d\n", \
(unsigned long)HEAP_TOP(p),(sz),__FILE__,__LINE__)), \
*/
-#ifdef CHECK_FOR_HOLES
-#define HAlloc(p, sz) \
- (ASSERT_EXPR((sz) >= 0), \
- ErtsHAllocLockCheck(p), \
- ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
- ? erts_heap_alloc((p),(sz)) \
- : (erts_set_hole_marker(HEAP_TOP(p), (sz)), \
- HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
+# ifdef CHECK_FOR_HOLES
+# define INIT_HEAP_MEM(p,sz) erts_set_hole_marker(HEAP_TOP(p), (sz))
+# else
+# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),DEBUG_BAD_BYTE,(sz)*sizeof(Eterm*))
+# endif
#else
-#define HAlloc(p, sz) \
- (ASSERT_EXPR((sz) >= 0), \
- ErtsHAllocLockCheck(p), \
- ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
- ? erts_heap_alloc((p),(sz)) \
- : (memset(HEAP_TOP(p),DEBUG_BAD_BYTE,(sz)*sizeof(Eterm*)), \
- HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
-#endif
+# define INIT_HEAP_MEM(p,sz) ((void)0)
+#endif /* DEBUG */
+
+
+#ifdef FORCE_HEAP_FRAGS
+# define IS_FORCE_HEAP_FRAGS 1
#else
+# define IS_FORCE_HEAP_FRAGS 0
+#endif
/*
* Allocate heap memory, first on the ordinary heap;
* failing that, in a heap fragment.
*/
-#define HAlloc(p, sz) \
- (ASSERT_EXPR((sz) >= 0), \
- ErtsHAllocLockCheck(p), \
- ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
- ? erts_heap_alloc((p),(sz)) \
- : (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
+#define HAlloc(p, sz) \
+ (ASSERT_EXPR((sz) >= 0), \
+ ErtsHAllocLockCheck(p), \
+ (IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
+ ? erts_heap_alloc((p),(sz)) \
+ : (INIT_HEAP_MEM(p,sz), \
+ HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
-#endif /* DEBUG */
-#if defined(CHECK_FOR_HOLES)
-# define HRelease(p, endp, ptr) \
+#define HRelease(p, endp, ptr) \
if ((ptr) == (endp)) { \
; \
} else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \
HEAP_TOP(p) = (ptr); \
} else { \
- erts_arith_shrink(p, ptr); \
+ erts_heap_frag_shrink(p, ptr); \
}
-#else
-# define HRelease(p, endp, ptr) \
- if ((ptr) == (endp)) { \
- ; \
- } else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \
- HEAP_TOP(p) = (ptr); \
- }
-#endif
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index f380e7732e..24887b3dea 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -1013,6 +1013,34 @@ term_to_binary_2(Process* p, Eterm Term, Eterm Flags)
return erts_term_to_binary(p, Term, level, flags);
}
+static uLongf binary2term_uncomp_size(byte* data, Sint size)
+{
+ z_stream stream;
+ int err;
+ const uInt chunk_size = 64*1024; /* Ask tmp-alloc about a suitable size? */
+ void* tmp_buf = erts_alloc(ERTS_ALC_T_TMP, chunk_size);
+ uLongf uncomp_size = 0;
+
+ stream.next_in = (Bytef*)data;
+ stream.avail_in = (uInt)size;
+ stream.next_out = tmp_buf;
+ stream.avail_out = (uInt)chunk_size;
+
+ erl_zlib_alloc_init(&stream);
+
+ err = inflateInit(&stream);
+ if (err == Z_OK) {
+ while ((err = inflate(&stream, Z_NO_FLUSH)) == Z_OK) {
+ uncomp_size += chunk_size - stream.avail_out;
+ stream.next_out = tmp_buf;
+ stream.avail_out = chunk_size;
+ }
+ inflateEnd(&stream);
+ }
+ erts_free(ERTS_ALC_T_TMP, tmp_buf);
+ return err == Z_STREAM_END ? uncomp_size : 0;
+}
+
static ERTS_INLINE Sint
binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
{
@@ -1036,10 +1064,18 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
state->extp = bytes;
}
else {
- uLongf dest_len = get_int32(bytes+1);
- state->extp = erts_alloc(ERTS_ALC_T_TMP, dest_len);
+ uLongf dest_len = (Uint32) get_int32(bytes+1);
+ bytes += 5;
+ size -= 5;
+ if (dest_len > 32*1024*1024
+ || (state->extp = erts_alloc_fnf(ERTS_ALC_T_TMP, dest_len)) == NULL) {
+ if (dest_len != binary2term_uncomp_size(bytes, size)) {
+ goto error;
+ }
+ state->extp = erts_alloc(ERTS_ALC_T_TMP, dest_len);
+ }
state->exttmp = 1;
- if (erl_zlib_uncompress(state->extp, &dest_len, bytes+5, size-5) != Z_OK)
+ if (erl_zlib_uncompress(state->extp, &dest_len, bytes, size) != Z_OK)
goto error;
size = (Sint) dest_len;
}
@@ -1840,9 +1876,80 @@ is_external_string(Eterm list, int* p_is_string)
return len;
}
+/* Assumes that the ones to undo are preluding the lists. */
+static void
+undo_offheap_in_area(ErlOffHeap* off_heap, Eterm* start, Eterm* end)
+{
+ const Uint area_sz = (end - start) * sizeof(Eterm);
+ struct proc_bin* mso;
+ struct proc_bin** mso_nextp = NULL;
+#ifndef HYBRID /* FIND ME! */
+ struct erl_fun_thing* funs;
+ struct erl_fun_thing** funs_nextp = NULL;
+#endif
+ struct external_thing_* ext;
+ struct external_thing_** ext_nextp = NULL;
+
+ for (mso = off_heap->mso; ; mso=mso->next) {
+ if (!in_area(mso, start, area_sz)) {
+ if (mso_nextp != NULL) {
+ *mso_nextp = NULL;
+ erts_cleanup_mso(off_heap->mso);
+ off_heap->mso = mso;
+ }
+ break;
+ }
+ mso_nextp = &mso->next;
+ }
+
+#ifndef HYBRID /* FIND ME! */
+ for (funs = off_heap->funs; ; funs=funs->next) {
+ if (!in_area(funs, start, area_sz)) {
+ if (funs_nextp != NULL) {
+ *funs_nextp = NULL;
+ erts_cleanup_funs(off_heap->funs);
+ off_heap->funs = funs;
+ }
+ break;
+ }
+ funs_nextp = &funs->next;
+ }
+#endif
+ for (ext = off_heap->externals; ; ext=ext->next) {
+ if (!in_area(ext, start, area_sz)) {
+ if (ext_nextp != NULL) {
+ *ext_nextp = NULL;
+ erts_cleanup_externals(off_heap->externals);
+ off_heap->externals = ext;
+ }
+ break;
+ }
+ ext_nextp = &ext->next;
+ }
+
+ /* Assert that the ones to undo were indeed preluding the lists. */
+#ifdef DEBUG
+ for (mso = off_heap->mso; mso != NULL; mso=mso->next) {
+ ASSERT(!in_area(mso, start, area_sz));
+ }
+# ifndef HYBRID /* FIND ME! */
+ for (funs = off_heap->funs; funs != NULL; funs=funs->next) {
+ ASSERT(!in_area(funs, start, area_sz));
+ }
+# endif
+ for (ext = off_heap->externals; ext != NULL; ext=ext->next) {
+ ASSERT(!in_area(ext, start, area_sz));
+ }
+#endif /* DEBUG */
+}
+
+/* Decode term from external format into *objp.
+** On failure return NULL and (R13B04) *hpp will be unchanged.
+*/
static byte*
dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp)
{
+ Eterm* hp_saved = *hpp;
int n;
register Eterm* hp = *hpp; /* Please don't take the address of hp */
Eterm* next = objp;
@@ -2043,7 +2150,7 @@ dec_term_atom_common:
ep = dec_pid(edep, hpp, ep, off_heap, objp);
hp = *hpp;
if (ep == NULL) {
- return NULL;
+ goto error;
}
break;
case PORT_EXT:
@@ -2278,7 +2385,7 @@ dec_term_atom_common:
ep = dec_term(edep, hpp, ep, off_heap, &temp);
hp = *hpp;
if (ep == NULL) {
- return NULL;
+ goto error;
}
if (!is_small(temp)) {
goto error;
@@ -2308,8 +2415,6 @@ dec_term_atom_common:
Sint old_index;
unsigned num_free;
int i;
- Eterm* temp_hp;
- Eterm** hpp = &temp_hp;
Eterm temp;
ep += 4; /* Skip total size in bytes */
@@ -2321,23 +2426,16 @@ dec_term_atom_common:
num_free = get_int32(ep);
ep += 4;
hp += ERL_FUN_SIZE;
- if (num_free > 0) {
- /* Don't leave a hole in case we fail */
- *hp = make_pos_bignum_header(num_free-1);
- }
hp += num_free;
- *hpp = hp;
funp->thing_word = HEADER_FUN;
funp->num_free = num_free;
- funp->creator = NIL; /* Don't leave a hole in case we fail */
*objp = make_fun(funp);
/* Module */
- if ((ep = dec_atom(edep, ep, &temp)) == NULL) {
+ if ((ep = dec_atom(edep, ep, &module)) == NULL) {
goto error;
}
- module = temp;
-
+ *hpp = hp;
/* Index */
if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) {
goto error;
@@ -2394,17 +2492,11 @@ dec_term_atom_common:
Sint old_index;
unsigned num_free;
int i;
- Eterm* temp_hp;
- Eterm** hpp = &temp_hp;
Eterm temp;
num_free = get_int32(ep);
ep += 4;
hp += ERL_FUN_SIZE;
- if (num_free > 0) {
- /* Don't leave a hole in the heap in case we fail. */
- *hp = make_pos_bignum_header(num_free-1);
- }
hp += num_free;
*hpp = hp;
funp->thing_word = HEADER_FUN;
@@ -2412,23 +2504,16 @@ dec_term_atom_common:
*objp = make_fun(funp);
/* Creator pid */
- switch(*ep) {
- case PID_EXT:
- ep = dec_pid(edep, hpp, ++ep, off_heap, &funp->creator);
- if (ep == NULL) {
- funp->creator = NIL; /* Don't leave a hole in the heap */
- goto error;
- }
- break;
- default:
+ if (*ep != PID_EXT
+ || (ep = dec_pid(edep, hpp, ++ep, off_heap,
+ &funp->creator))==NULL) {
goto error;
}
/* Module */
- if ((ep = dec_atom(edep, ep, &temp)) == NULL) {
+ if ((ep = dec_atom(edep, ep, &module)) == NULL) {
goto error;
}
- module = temp;
/* Index */
if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) {
@@ -2455,7 +2540,6 @@ dec_term_atom_common:
funp->next = off_heap->funs;
off_heap->funs = funp;
#endif
-
old_uniq = unsigned_val(temp);
funp->fe = erts_put_fun_entry(module, old_uniq, old_index);
@@ -2474,12 +2558,15 @@ dec_term_atom_common:
}
default:
error:
- /*
- * Be careful to return the updated heap pointer, to avoid
- * that the caller wipes out binaries or other off-heap objects
- * that may have been linked into the process.
+ /* UNDO:
+ * Must unlink all off-heap objects that may have been
+ * linked into the process.
*/
- *hpp = hp;
+ if (hp < *hpp) { /* Sometimes we used hp and sometimes *hpp */
+ hp = *hpp; /* the largest must be the freshest */
+ }
+ undo_offheap_in_area(off_heap, hp_saved, hp);
+ *hpp = hp_saved;
return NULL;
}
}
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 62a788cbff..df0ab40074 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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%
*/
@@ -1658,7 +1658,6 @@ void erts_bif_trace_init(void);
/*
** Call_trace uses this API for the parameter matching functions
*/
- struct erl_heap_fragment* saved_program_buf;
#define MatchSetRef(MPSP) \
do { \
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index be442fa480..c162395159 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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%
*/
@@ -95,6 +95,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq)
#endif
+
Eterm*
erts_heap_alloc(Process* p, Uint need)
{
@@ -105,13 +106,29 @@ erts_heap_alloc(Process* p, Uint need)
Uint i;
#endif
+#ifdef FORCE_HEAP_FRAGS
+ if (p->space_verified && p->space_verified_from!=NULL
+ && HEAP_TOP(p) >= p->space_verified_from
+ && HEAP_TOP(p) + need <= p->space_verified_from + p->space_verified
+ && HEAP_LIMIT(p) - HEAP_TOP(p) >= need) {
+
+ Uint consumed = need + (HEAP_TOP(p) - p->space_verified_from);
+ ASSERT(consumed <= p->space_verified);
+ p->space_verified -= consumed;
+ p->space_verified_from += consumed;
+ HEAP_TOP(p) = p->space_verified_from;
+ return HEAP_TOP(p) - need;
+ }
+ p->space_verified = 0;
+ p->space_verified_from = NULL;
+#endif /* FORCE_HEAP_FRAGS */
+
n = need;
#ifdef DEBUG
n++;
#endif
bp = (ErlHeapFragment*)
- ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG,
- sizeof(ErlHeapFragment) + ((n-1)*sizeof(Eterm)));
+ ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(n));
#ifdef DEBUG
n--;
@@ -140,6 +157,7 @@ erts_heap_alloc(Process* p, Uint need)
bp->next = MBUF(p);
MBUF(p) = bp;
bp->size = n;
+ bp->used_size = n;
MBUF_SIZE(p) += n;
bp->off_heap.mso = NULL;
#ifndef HYBRID /* FIND ME! */
@@ -151,34 +169,6 @@ erts_heap_alloc(Process* p, Uint need)
return bp->mem;
}
-void erts_arith_shrink(Process* p, Eterm* hp)
-{
-#if defined(CHECK_FOR_HOLES)
- ErlHeapFragment* hf;
-
- /*
- * We must find the heap fragment that hp points into.
- * If we are unlucky, we might have to search through
- * a large part of the list. We'll hope that will not
- * happen too often.
- */
- for (hf = MBUF(p); hf != 0; hf = hf->next) {
- if (hp - hf->mem < (unsigned long)hf->size) {
- /*
- * We are not allowed to changed hf->size (because the
- * size must be correct when deallocating). Therefore,
- * clear out the uninitialized part of the heap fragment.
- */
- Eterm* to = hf->mem + hf->size;
- while (hp < to) {
- *hp++ = NIL;
- }
- break;
- }
- }
-#endif
-}
-
#ifdef CHECK_FOR_HOLES
Eterm*
erts_set_hole_marker(Eterm* ptr, Uint sz)
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 44b6bbe785..db2b3e10db 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -580,11 +580,18 @@ corrupter(Term) ->
?line corrupter(CompressedBin, size(CompressedBin)-1).
corrupter(Bin, Pos) when Pos >= 0 ->
- ?line {ShorterBin, _} = split_binary(Bin, Pos),
+ ?line {ShorterBin, Rest} = split_binary(Bin, Pos),
?line catch binary_to_term(ShorterBin), %% emulator shouldn't crash
?line MovedBin = list_to_binary([ShorterBin]),
?line catch binary_to_term(MovedBin), %% emulator shouldn't crash
- ?line corrupter(MovedBin, Pos-1);
+
+ %% Bit faults, shouldn't crash
+ <<Byte,Tail/binary>> = Rest,
+ Fun = fun(M) -> FaultyByte = Byte bxor M,
+ catch binary_to_term(<<ShorterBin/binary,
+ FaultyByte, Tail/binary>>) end,
+ ?line lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]),
+ ?line corrupter(Bin, Pos-1);
corrupter(_Bin, _) ->
ok.
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index 716ee3707d..a7889dfe90 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% 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%
%%
@@ -627,7 +627,13 @@ refc_dist_1() ->
%% Fun is passed in an exit signal. Wait until it is gone.
?line wait_until(fun () -> 4 =/= fun_refc(F2) end),
?line 3 = fun_refc(F2),
- ?line 3 = fun_refc(F),
+ erts_debug:set_internal_state(available_internal_state, true),
+ ?line F_refc = case erts_debug:get_internal_state(force_heap_frags) of
+ false -> 3;
+ true -> 2 % GC after bif already decreased it
+ end,
+ ?line F_refc = fun_refc(F),
+ erts_debug:set_internal_state(available_internal_state, false),
refc_dist_send(Node, F).
refc_dist_send(Node, F) ->
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index bc12821887..9e1732a445 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% 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%
%%
@@ -212,17 +212,18 @@ reductions(Config) when is_list(Config) ->
%% 300 * 4 is more than CONTEXT_REDS (1000). Thus, there will be one or
%% more context switches.
- reductions(300, Reductions).
+ Mask = (1 bsl erlang:system_info(wordsize)*8) - 1,
+ reductions(300, Reductions, Mask).
-reductions(N, Previous) when N > 0 ->
+reductions(N, Previous, Mask) when N > 0 ->
?line {Reductions, Diff} = statistics(reductions),
?line build_some_garbage(),
?line if Reductions > 0 -> ok end,
?line if Diff >= 0 -> ok end,
io:format("Previous = ~p, Reductions = ~p, Diff = ~p, DiffShouldBe = ~p",
- [Previous, Reductions, Diff, Reductions-Previous]),
- ?line if Reductions == Previous+Diff -> reductions(N-1, Reductions) end;
-reductions(0, _) ->
+ [Previous, Reductions, Diff, (Reductions-Previous) band Mask]),
+ ?line if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end;
+reductions(0, _, _) ->
ok.
build_some_garbage() ->
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 2c60ba6838..e9713fcf0f 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% 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%
%%
@@ -498,19 +498,23 @@ system_monitor_long_gc_1(doc) ->
["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"];
system_monitor_long_gc_1(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
- try
- %% Add ?LONG_GC_SLEEP ms to all gc
- ?line erts_debug:set_internal_state(test_long_gc_sleep,
- ?LONG_GC_SLEEP),
- ?line LoadFun =
- fun () ->
- garbage_collect(),
- self()
- end,
- ?line long_gc(LoadFun, false)
+ try
+ case erts_debug:get_internal_state(force_heap_frags) of
+ true ->
+ {skip,"emulator with FORCE_HEAP_FRAGS defined"};
+ false ->
+ %% Add ?LONG_GC_SLEEP ms to all gc
+ ?line erts_debug:set_internal_state(test_long_gc_sleep,
+ ?LONG_GC_SLEEP),
+ ?line LoadFun = fun () ->
+ garbage_collect(),
+ self()
+ end,
+ ?line long_gc(LoadFun, false)
+ end
after
erts_debug:set_internal_state(test_long_gc_sleep, 0),
- erts_debug:set_internal_state(available_internal_state, false)
+ erts_debug:set_internal_state(available_internal_state, false)
end.
system_monitor_long_gc_2(suite) ->
@@ -520,24 +524,29 @@ system_monitor_long_gc_2(doc) ->
system_monitor_long_gc_2(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
try
- %% Add ?LONG_GC_SLEEP ms to all gc
- ?line erts_debug:set_internal_state(test_long_gc_sleep,
- ?LONG_GC_SLEEP),
- ?line Parent = self(),
- ?line LoadFun =
- fun () ->
- Ref = make_ref(),
- Pid =
- spawn_link(
- fun () ->
- garbage_collect(),
- Parent ! {Ref, self()}
- end),
- receive {Ref, Pid} -> Pid end
- end,
- ?line long_gc(LoadFun, true),
- ?line long_gc(LoadFun, true),
- ?line long_gc(LoadFun, true)
+ case erts_debug:get_internal_state(force_heap_frags) of
+ true ->
+ {skip,"emulator with FORCE_HEAP_FRAGS defined"};
+ false ->
+ %% Add ?LONG_GC_SLEEP ms to all gc
+ ?line erts_debug:set_internal_state(test_long_gc_sleep,
+ ?LONG_GC_SLEEP),
+ ?line Parent = self(),
+ ?line LoadFun =
+ fun () ->
+ Ref = make_ref(),
+ Pid =
+ spawn_link(
+ fun () ->
+ garbage_collect(),
+ Parent ! {Ref, self()}
+ end),
+ receive {Ref, Pid} -> Pid end
+ end,
+ ?line long_gc(LoadFun, true),
+ ?line long_gc(LoadFun, true),
+ ?line long_gc(LoadFun, true)
+ end
after
erts_debug:set_internal_state(test_long_gc_sleep, 0),
erts_debug:set_internal_state(available_internal_state, false)