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.

12 files changed, 378 insertions, 327 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)