HALFWORD ETS match spec heap fragment optimization

Introduce HAllocX to allocate heap fragments with a larger capacity
than requested and by that reduce the number of fragments allocated.

5 files changed, 24 insertions, 23 deletions

diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 7f17d1212f..69b6261549 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -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)
@@ -1594,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);
@@ -1661,7 +1662,7 @@ 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 = HAlloc(p, sz);
+	Eterm* top = HAllocX(p, sz, HEAP_XTRA);
 	return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL);
     }
     return term;
@@ -1928,20 +1929,20 @@ restart:
 	    }
 	    break;
 	case matchConsA:
-	    ehp = HAlloc(build_proc, 2);
+	    ehp = HAllocX(build_proc, 2, HEAP_XTRA);
 	    CDR(ehp) = *--esp;
 	    CAR(ehp) = esp[-1];
 	    esp[-1] = make_list(ehp);
 	    break;
 	case matchConsB:
-	    ehp = HAlloc(build_proc, 2);
+	    ehp = HAllocX(build_proc, 2, HEAP_XTRA);
 	    CAR(ehp) = *--esp;
 	    CDR(ehp) = esp[-1];
 	    esp[-1] = make_list(ehp);
 	    break;
 	case matchMkTuple:
 	    n = *pc++;
-	    ehp = HAlloc(build_proc, n+1);
+	    ehp = HAllocX(build_proc, n+1, HEAP_XTRA);
 	    t = make_tuple(ehp);
 	    *ehp++ = make_arityval(n);
 	    while (n--) {
@@ -2042,7 +2043,7 @@ restart:
 		Uint sz;
 		Eterm* top;
 		sz = size_object_rel(term, base);
-		top = HAlloc(build_proc, sz);
+		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,
@@ -2061,7 +2062,7 @@ restart:
 	    ASSERT_HALFWORD(base == NULL);
 	    n = arity; /* Only happens when 'term' is an array */
 	    tp = termp;
-	    ehp = HAlloc(build_proc, n*2);
+	    ehp = HAllocX(build_proc, n*2, HEAP_XTRA);
 	    *esp++  = make_list(ehp);
 	    while (n--) {
 		*ehp++ = *tp++;
@@ -2207,7 +2208,7 @@ restart:
 	    else {
 		Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
 		Uint sender_sz = is_immed(sender) ? 0 : size_object(sender);
-		ehp = HAlloc(build_proc, 6 + sender_sz);
+		ehp = HAllocX(build_proc, 6 + sender_sz, HEAP_XTRA);
  		*esp++ = make_tuple(ehp);
  		ehp[0] = make_arityval(5);
  		ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p);
@@ -2270,7 +2271,7 @@ restart:
 	    if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) {
  		*esp++ = am_undefined;
  	    } else {
-		ehp = HAlloc(build_proc, 4);
+		ehp = HAllocX(build_proc, 4, HEAP_XTRA);
  		*esp++ = make_tuple(ehp);
 		ehp[0] = make_arityval(3);
 		ehp[1] = cp[0];
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 529b602575..2f9295e624 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -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;
 }
 
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_vm.h b/erts/emulator/beam/erl_vm.h
index 48fa99934e..d6daf0cc4b 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.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,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/utils.c b/erts/emulator/beam/utils.c
index 2d0155bdf5..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;