erts: Add age order first fit allocator strategies

ageffcaoff: Age First Fit Carrier, Address Order First Fit (within carrier)
ageffcbf  : Age First Fit Carrier, Best Fit (within carrier)
ageffcaobf: Age First Fit Carrier, Address Order Best Fit (within carrier)

Prefer old carriers, the older the better.

5 files changed, 115 insertions, 37 deletions

diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index 0d2b89ae42..4b43836742 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -225,6 +225,33 @@
           used. The time complexity is proportional to log N, where
           N is the number of free blocks.</p>
       </item>
+      <tag>Age order first fit carrier address order first fit</tag>
+      <item>
+	<p>Strategy: Find the <em>oldest carrier</em> that
+          can satisfy the requested block size, then find a block within
+          that carrier using the "address order first fit" strategy.</p>
+        <p>Implementation: A balanced binary search tree is
+          used. The time complexity is proportional to log N, where
+          N is the number of free blocks.</p>
+      </item>
+      <tag>Age order first fit carrier best fit</tag>
+      <item>
+        <p>Strategy: Find the <em>oldest carrier</em> that
+          can satisfy the requested block size, then find a block within
+          that carrier using the "best fit" strategy.</p>
+        <p>Implementation: Balanced binary search trees are
+          used. The time complexity is proportional to log N, where
+          N is the number of free blocks.</p>
+      </item>
+      <tag>Age order first fit carrier address order best fit</tag>
+      <item>
+        <p>Strategy: Find the <em>oldest carrier</em> that
+          can satisfy the requested block size, then find a block within
+          that carrier using the "address order best fit" strategy.</p>
+        <p>Implementation: Balanced binary search trees are
+          used. The time complexity is proportional to log N, where
+          N is the number of free blocks.</p>
+      </item>
       <tag>Good fit</tag>
       <item>
         <p>Strategy: Try to find the best fit, but settle for the best fit
@@ -467,7 +494,8 @@
             fetched, it will function as an ordinary carrier. This feature has
             special requirements on the
             <seealso marker="#M_as">allocation strategy</seealso> used. Only
-            the strategies <c>aoff</c>, <c>aoffcbf</c>, and <c>aoffcaobf</c>
+            the strategies <c>aoff</c>, <c>aoffcbf</c>, <c>aoffcaobf</c>,
+	    <c>ageffcaoff</c>m, <c>ageffcbf</c> and <c>ageffcaobf</c>
             support abandoned carriers.</p>
           <p>This feature also requires
             <seealso marker="#M_t">multiple thread specific instances</seealso>
@@ -501,7 +529,7 @@
         </item>
 
         <tag><marker id="M_as"/>
-          <c><![CDATA[+M<S>as bf|aobf|aoff|aoffcbf|aoffcaobf|gf|af]]></c></tag>
+          <c><![CDATA[+M<S>as bf|aobf|aoff|aoffcbf|aoffcaobf|ageffcaoff|ageffcbf|ageffcaobf|gf|af]]></c></tag>
         <item>
           <p>Allocation strategy. The following strategies are valid:</p>
           <list type="bulleted">
@@ -512,6 +540,11 @@
             </item>
             <item><c>aoffcaobf</c> (address order first fit carrier address
               order best fit)</item>
+            <item><c>ageffcaoff</c> (age order first fit carrier address order first fit)</item>
+            <item><c>ageffcbf</c> (age order first fit carrier best fit)
+            </item>
+            <item><c>ageffcaobf</c> (age order first fit carrier address
+              order best fit)</item>
             <item><c>gf</c> (good fit)</item>
             <item><c>af</c> (a fit)</item>
           </list>
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 4c9fb466eb..67cd3afb25 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -604,7 +604,7 @@ static ERTS_INLINE int
 strategy_support_carrier_migration(struct au_init *auip)
 {
     /*
-     * Currently only aoff, aoffcbf and aoffcaobf support carrier
+     * Currently only aoff* and ageff* support carrier
      * migration, i.e, type AOFIRSTFIT.
      */
     return auip->atype == FIRSTFIT;
@@ -1432,6 +1432,21 @@ handle_au_arg(struct au_init *auip,
 		auip->init.aoff.crr_order = FF_AOFF;
 		auip->init.aoff.blk_order = FF_AOBF;
 	    }
+            else if (strcmp("ageffcaoff", alg) == 0) {
+                auip->atype = FIRSTFIT;
+		auip->init.aoff.crr_order = FF_AGEFF;
+		auip->init.aoff.blk_order = FF_AOFF;
+            }
+            else if (strcmp("ageffcbf", alg) == 0) {
+                auip->atype = FIRSTFIT;
+		auip->init.aoff.crr_order = FF_AGEFF;
+		auip->init.aoff.blk_order = FF_BF;
+            }
+            else if (strcmp("ageffcaobf", alg) == 0) {
+                auip->atype = FIRSTFIT;
+		auip->init.aoff.crr_order = FF_AGEFF;
+		auip->init.aoff.blk_order = FF_AOBF;
+            }
 	    else {
 		bad_value(param, sub_param + 1, alg);
 	    }
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 8808a4f0a4..ad34fb389a 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -20,7 +20,7 @@
 
 
 /*
- * Description:	An "address order first fit" allocator
+ * Description:	A family of "first fit" allocator strategies
  *              based on a Red-Black (binary search) Tree. The search,
  *              insert, and delete operations are all O(log n) operations
  *              on a Red-Black Tree.
@@ -40,6 +40,10 @@
  *              sorting order. Blocks within the same carrier are sorted
  *              wrt size instead of address. The 'max_sz' field is maintained
  *              in order to dismiss entire carriers with too small blocks. 
+ * Age Order:
+ *      	Carriers are ordered by creation time instead of address.
+ *      	Oldest carrier with a large enough free block is chosen.
+ *      	No age order supported for blocks.
  *
  * Authors: 	Rickard Green/Sverker Eriksson
  */
@@ -53,10 +57,12 @@
 #include "erl_ao_firstfit_alloc.h"
 
 #ifdef DEBUG
+# define IS_DEBUG 1
 #if 0
 #define HARD_DEBUG
 #endif
 #else
+# define IS_DEBUG 0
 #undef HARD_DEBUG
 #endif
 
@@ -121,6 +127,7 @@ typedef struct AOFF_Carrier_t_ AOFF_Carrier_t;
 struct AOFF_Carrier_t_ {
     Carrier_t crr;
     AOFF_RBTree_t rbt_node;     /* My node in the carrier tree */
+    Sint64 birth_time;
     AOFF_RBTree_t* root;        /* Root of my block tree */
 };
 #define RBT_NODE_TO_MBC(PTR) ErtsContainerStruct((PTR), AOFF_Carrier_t, rbt_node)
@@ -179,11 +186,26 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
     else ASSERT(new_max == old_max);
 }
 
+/* Compare nodes for both carrier and block trees */
 static ERTS_INLINE SWord cmp_blocks(enum AOFFSortOrder order,
 				    AOFF_RBTree_t* lhs, AOFF_RBTree_t* rhs)
 {
     ASSERT(lhs != rhs);
-    {
+    if (order == FF_AGEFF) {
+	AOFF_Carrier_t* lc = RBT_NODE_TO_MBC(lhs);
+	AOFF_Carrier_t* rc = RBT_NODE_TO_MBC(rhs);
+	Sint64 diff = lc->birth_time - rc->birth_time;
+ #ifdef ARCH_64
+        if (diff)
+            return diff;
+ #else
+        if (diff < 0)
+            return -1;
+        else if (diff > 0)
+            return 1;
+ #endif
+    }
+    else {
 	ASSERT(order == FF_AOFF || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr));
 	if (order != FF_AOFF) {
 	    SWord diff = (SWord)AOFF_BLK_SZ(lhs) - (SWord)AOFF_BLK_SZ(rhs);
@@ -193,9 +215,11 @@ static ERTS_INLINE SWord cmp_blocks(enum AOFFSortOrder order,
     return (char*)lhs - (char*)rhs;
 }
 
+/* Compare candidate block. Only for block tree */
 static ERTS_INLINE SWord cmp_cand_blk(enum AOFFSortOrder order,
 				      Block_t* cand_blk, AOFF_RBTree_t* rhs)
 {
+    ASSERT(order != FF_AGEFF);
     if (order != FF_AOFF) {
 	if (BLK_TO_MBC(cand_blk) == FBLK_TO_MBC(&rhs->hdr)) {
 	    SWord diff = (SWord)MBC_BLK_SZ(cand_blk) - (SWord)MBC_FBLK_SZ(&rhs->hdr);
@@ -232,10 +256,17 @@ static void init_atoms(void);
 
 static int atoms_initialized = 0;
 
+#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+static erts_atomic64_t birth_time_counter;
+#endif
+
 void
 erts_aoffalc_init(void)
 {
     atoms_initialized = 0;
+#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+    erts_atomic64_init_nob(&birth_time_counter, 0);
+#endif
 }
 
 Allctr_t *
@@ -875,6 +906,15 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
     return (Block_t *) blk;
 }
 
+static ERTS_INLINE Sint64 get_birth_time(void)
+{
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+    return (Sint64) erts_os_monotonic_time();
+#else
+    return (Sint64) erts_atomic64_inc_read_nob(&birth_time_counter);
+#endif
+}
+
 static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
 {
     AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
@@ -883,9 +923,9 @@ static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
 
     HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
 
-    /* Link carrier in address order tree
-     */
     crr->rbt_node.hdr.bhdr = 0;
+    if (alc->crr_order == FF_AGEFF || IS_DEBUG)
+	crr->birth_time = get_birth_time();
     rbt_insert(alc->crr_order, root, &crr->rbt_node);
 
     /* aoff_link_free_block will add free block later */
@@ -916,8 +956,6 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
     ASSERT(!IS_CRR_IN_TREE(crr, *root));
     HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);   
 
-    /* Link carrier in address order tree
-     */
     rbt_insert(alc->crr_order, root, &crr->rbt_node);
 
     HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
@@ -958,17 +996,17 @@ static UWord aoff_largest_fblk_in_mbc(Allctr_t* allctr, Carrier_t* carrier)
  * info_options()
  */
 
+static const char* flavor_str[2][3] = {
+    {"ageffcaoff", "ageffcaobf", "ageffcbf"},
+    {      "aoff",  "aoffcaobf",  "aoffcbf"}
+};
+static Eterm flavor_atoms[2][3];
+
 static struct {
     Eterm as;
-    Eterm aoff;
-    Eterm aoffcaobf;
-    Eterm aoffcbf;
-#ifdef DEBUG
-    Eterm end_of_atoms;
-#endif
 } am;
 
-static void ERTS_INLINE atom_init(Eterm *atom, char *name)
+static void ERTS_INLINE atom_init(Eterm *atom, const char *name)
 {
     *atom = am_atom_put(name, strlen(name));
 }
@@ -977,28 +1015,16 @@ static void ERTS_INLINE atom_init(Eterm *atom, char *name)
 static void
 init_atoms(void)
 {
-#ifdef DEBUG
-    Eterm *atom;
-#endif
+    int i, j;
 
     if (atoms_initialized)
 	return;
 
-#ifdef DEBUG
-    for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) {
-	*atom = THE_NON_VALUE;
-    }
-#endif
     AM_INIT(as);
-    AM_INIT(aoff);
-    AM_INIT(aoffcaobf);
-    AM_INIT(aoffcbf);
 
-#ifdef DEBUG
-    for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
-	ASSERT(*atom != THE_NON_VALUE);
-    }
-#endif
+    for (i = 0; i < 2; i++)
+        for (j = 0; j < 3; j++)
+            atom_init(&flavor_atoms[i][j], flavor_str[i][j]);
 
     atoms_initialized = 1;
 }
@@ -1024,15 +1050,16 @@ info_options(Allctr_t *allctr,
 {
     AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr;
     Eterm res = THE_NON_VALUE;
-    const char* flavor_str[3] = {"aoff", "aoffcaobf", "aoffcbf"};
-    Eterm flavor_atom[3] = {am.aoff, am.aoffcaobf, am.aoffcbf};
+
+    ASSERT(alc->crr_order >= 0 && alc->crr_order <= 1);
+    ASSERT(alc->blk_order >= 1 && alc->blk_order <= 3);
 
     if (print_to_p) {
 	erts_print(*print_to_p,
 		   print_to_arg,
 		   "%sas: %s\n",
 		   prefix,
-		   flavor_str[alc->blk_order-1]);
+		   flavor_str[alc->crr_order][alc->blk_order-1]);
     }
 
     if (hpp || szp) {
@@ -1042,7 +1069,8 @@ info_options(Allctr_t *allctr,
 		     __FILE__, __LINE__);;
 
 	res = NIL;
-	add_2tup(hpp, szp, &res, am.as, flavor_atom[alc->blk_order-1]);
+	add_2tup(hpp, szp, &res, am.as,
+                 flavor_atoms[alc->crr_order][alc->blk_order-1]);
     }
 
     return res;
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h
index 7864f6c914..b5492551e6 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.h
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h
@@ -29,6 +29,7 @@
 typedef struct AOFFAllctr_t_ AOFFAllctr_t;
 
 enum AOFFSortOrder {
+    FF_AGEFF = 0,
     FF_AOFF  = 1,
     FF_AOBF  = 2,
     FF_BF    = 3
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 3a721095e2..61d2adcbca 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -67,7 +67,8 @@ cpool(Cfg) -> drv_case(Cfg).
 migration(Cfg) ->
     case erlang:system_info(smp_support) of
 	true ->
-	    drv_case(Cfg, concurrent, "+MZe true");
+	    drv_case(Cfg, concurrent, "+MZe true"),
+	    drv_case(Cfg, concurrent, "+MZe true +MZas ageffcbf");
 	false ->
 	    {skipped, "No smp"}
     end.