erts: Rewrite memory instrumentation

This commit replaces the old memory instrumentation with a new
implementation that scans carriers instead of wrapping
erts_alloc/erts_free. The old implementation could not extract
information without halting the emulator, had considerable runtime
overhead, and the memory maps it produced were noisy and lacked
critical information.

Since the new implementation walks through existing data structures
there's no longer a need to start the emulator with special flags to
get information about carrier utilization/fragmentation. Memory
fragmentation is also easier to diagnose as it's presented on a
per-carrier basis which eliminates the need to account for "holes"
between mmap segments.

To help track allocations, each allocation can now be tagged with
what it is and who allocated it at the cost of one extra word per
allocation. This is controlled on a per-allocator basis with the
+M<S>atags option, and is enabled by default for binary_alloc and
driver_alloc (which is also used by NIFs).

1 files changed, 1333 insertions, 51 deletions

diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index fed51eb200..fdf355d503 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -48,6 +48,8 @@
 #include "erl_mseg.h"
 #include "erl_threads.h"
 #include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
+#include "erl_nif.h"
 
 #ifdef ERTS_ENABLE_LOCK_COUNT
 #include "erl_lock_count.h"
@@ -139,6 +141,33 @@ MBC after deallocating first block:
 [Carrier_t|pad|Block_t 111| udata... ]
 */
 
+/* Allocation tags ...
+ *
+ * These are added to the footer of every block when enabled. Currently they
+ * consist of the allocation type and an atom identifying the allocating
+ * driver/nif (or 'system' if that can't be determined), but the format is not
+ * supposed to be set in stone.
+ *
+ * The packing scheme requires that the atom values are small enough to fit
+ * into a word with ERTS_ALC_N_BITS to spare. Users must check for overflow
+ * before MAKE_ATAG(). */
+
+typedef UWord alcu_atag_t;
+
+#define MAKE_ATAG(IdAtom, Type) \
+    (ASSERT((Type) >= ERTS_ALC_N_MIN && (Type) <= ERTS_ALC_N_MAX), \
+     ASSERT(atom_val(IdAtom) <= MAX_ATAG_ATOM_ID), \
+     (atom_val(IdAtom) << ERTS_ALC_N_BITS) | (Type))
+
+#define ATAG_ID(AT) (make_atom((AT) >> ERTS_ALC_N_BITS))
+#define ATAG_TYPE(AT) ((AT) & ERTS_ALC_N_MASK)
+
+#define MAX_ATAG_ATOM_ID (ERTS_UWORD_MAX >> ERTS_ALC_N_BITS)
+
+#define DBG_IS_VALID_ATAG(Allocator, AT) \
+    (ATAG_TYPE(AT) >= ERTS_ALC_N_MIN && \
+     ATAG_TYPE(AT) <= ERTS_ALC_N_MAX && \
+     (Allocator)->alloc_no == ERTS_ALC_T2A(ERTS_ALC_N2T(ATAG_TYPE(AT))))
 
 /* Blocks ... */
 
@@ -153,10 +182,17 @@ MBC after deallocating first block:
 #endif
 #define FBLK_FTR_SZ (sizeof(FreeBlkFtr_t))
 
+#define GET_BLK_ATAG(B) \
+    (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1])
+#define SET_BLK_ATAG(B, T) \
+    (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1] = (T))
+
+#define BLK_ATAG_SZ(AP) ((AP)->atags ? sizeof(alcu_atag_t) : 0)
+
 #define UMEMSZ2BLKSZ(AP, SZ)						\
-  (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size				\
+  (ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ) <= (AP)->min_block_size		\
    ? (AP)->min_block_size						\
-   : UNIT_CEILING(ABLK_HDR_SZ + (SZ)))
+   : UNIT_CEILING(ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ)))
 
 #define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ))
 #define BLK2UMEM(P) ((void *)    (((char *) (P)) + ABLK_HDR_SZ))
@@ -688,6 +724,62 @@ static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **);
 static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp);
 static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int);
 
+static alcu_atag_t determine_alloc_tag(Allctr_t *allocator, ErtsAlcType_t type)
+{
+    ErtsSchedulerData *esdp;
+    Eterm id;
+
+    ERTS_CT_ASSERT(_unchecked_atom_val(am_system) <= MAX_ATAG_ATOM_ID);
+    ASSERT(allocator->atags);
+
+    esdp = erts_get_scheduler_data();
+    id = am_system;
+
+    if (esdp) {
+        if (esdp->current_nif) {
+            Module *mod = erts_nif_get_module((esdp->current_nif)->mod_nif);
+
+            /* Mod can be NULL if a resource destructor allocates memory after
+             * the module has been unloaded. */
+            if (mod) {
+                id = make_atom(mod->module);
+            }
+        } else if (esdp->current_port) {
+            Port *p = esdp->current_port;
+            id = (p->drv_ptr)->name_atom;
+        }
+
+        /* We fall back to 'system' if we can't pack the driver/NIF name into
+         * the tag. This may be a bit misleading but we've made no promises
+         * that the information is complete.
+         *
+         * This can only happen on 32-bit emulators when a new driver/NIF has
+         * been loaded *after* 16 million atoms have been used, and supporting
+         * that fringe case is not worth an extra word. 64-bit emulators are
+         * unaffected since the atom cache limits atom indexes to 32 bits. */
+        if(MAX_ATOM_TABLE_SIZE > MAX_ATAG_ATOM_ID) {
+            if (atom_val(id) > MAX_ATAG_ATOM_ID) {
+                id = am_system;
+            }
+        }
+    }
+
+    return MAKE_ATAG(id, type);
+}
+
+static void set_alloc_tag(Allctr_t *allocator, void *p, alcu_atag_t tag)
+{
+    Block_t *block;
+
+    ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+    ASSERT(allocator->atags && p);
+    (void)allocator;
+
+    block = UMEM2BLK(p);
+
+    SET_BLK_ATAG(block, tag);
+}
+
 /* internal data... */
 
 #if 0
@@ -4242,6 +4334,7 @@ static struct {
     Eterm e;
     Eterm t;
     Eterm ramv;
+    Eterm atags;
 #if HAVE_ERTS_MSEG
     Eterm asbcst;
     Eterm rsbcst;
@@ -4311,7 +4404,7 @@ static struct {
 #endif
 } am;
 
-static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES];
+static Eterm alloc_type_atoms[ERTS_ALC_N_MAX + 1];
 
 static ERTS_INLINE void atom_init(Eterm *atom, char *name)
 {
@@ -4342,6 +4435,7 @@ init_atoms(Allctr_t *allctr)
 	AM_INIT(e);
 	AM_INIT(t);
 	AM_INIT(ramv);
+	AM_INIT(atags);
 #if HAVE_ERTS_MSEG
 	AM_INIT(asbcst);
 	AM_INIT(rsbcst);
@@ -4413,12 +4507,12 @@ init_atoms(Allctr_t *allctr)
 	}
 #endif
 
-	for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
-	    ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
-	    char *name = (char *) ERTS_ALC_N2TD(n);
-	    size_t len = sys_strlen(name);
-	    fix_type_atoms[ix] = am_atom_put(name, len);
-	}
+        for (ix = ERTS_ALC_N_MIN; ix <= ERTS_ALC_N_MAX; ix++) {
+            const char *name = ERTS_ALC_N2TD(ix);
+            size_t len = sys_strlen(name);
+
+            alloc_type_atoms[ix] = am_atom_put(name, len);
+        }
     }
     
     if (allctr && !allctr->atoms_initialized) {
@@ -4531,6 +4625,7 @@ sz_info_fix(Allctr_t *allctr,
 		ErtsAlcFixList_t *fix = &allctr->fix[ix];
 		UWord alloced = fix->type_size * fix->u.cpool.allocated;
 		UWord used = fix->type_size * fix->u.cpool.used;
+                ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
 
 		if (print_to_p) {
 		    fmtfn_t to = *print_to_p;
@@ -4538,15 +4633,14 @@ sz_info_fix(Allctr_t *allctr,
 		    erts_print(to,
 			       arg,
 			       "fix type internal: %s %bpu %bpu\n",
-			       (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
-						      + ix),
+			       (char *) ERTS_ALC_N2TD(n),
 			       alloced,
 			       used);
 		}
 
 		if (hpp || szp) {
 		    add_3tup(hpp, szp, &res,
-			     fix_type_atoms[ix],
+			     alloc_type_atoms[n],
 			     bld_unstable_uint(hpp, szp, alloced),
 			     bld_unstable_uint(hpp, szp, used));
 		}
@@ -4559,6 +4653,7 @@ sz_info_fix(Allctr_t *allctr,
 	    ErtsAlcFixList_t *fix = &allctr->fix[ix];
 	    UWord alloced = fix->type_size * fix->u.nocpool.allocated;
 	    UWord used = fix->type_size*fix->u.nocpool.used;
+            ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
 
 	    if (print_to_p) {
 		fmtfn_t to = *print_to_p;
@@ -4566,15 +4661,14 @@ sz_info_fix(Allctr_t *allctr,
 		erts_print(to,
 			   arg,
 			   "fix type: %s %bpu %bpu\n",
-			   (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
-						  + ix),
+			   (char *) ERTS_ALC_N2TD(n),
 			   alloced,
 			   used);
 	    }
 
 	    if (hpp || szp) {
 		add_3tup(hpp, szp, &res,
-			 fix_type_atoms[ix],
+			 alloc_type_atoms[n],
 			 bld_unstable_uint(hpp, szp, alloced),
 			 bld_unstable_uint(hpp, szp, used));
 	    }
@@ -5000,6 +5094,7 @@ info_options(Allctr_t *allctr,
 		   "option e: true\n"
 		   "option t: %s\n"
 		   "option ramv: %s\n"
+		   "option atags: %s\n"
 		   "option sbct: %beu\n"
 #if HAVE_ERTS_MSEG
 		   "option asbcst: %bpu\n"
@@ -5018,6 +5113,7 @@ info_options(Allctr_t *allctr,
 		   "option acul: %bpu\n",
 		   topt,
 		   allctr->ramv ? "true" : "false",
+		   allctr->atags ? "true" : "false",
 		   allctr->sbc_threshold,
 #if HAVE_ERTS_MSEG
 		   allctr->mseg_opt.abs_shrink_th,
@@ -5087,6 +5183,7 @@ info_options(Allctr_t *allctr,
 		 am_sbct,
 		 bld_uint(hpp, szp, allctr->sbc_threshold));
 	add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false);
+	add_2tup(hpp, szp, &res, am.atags, allctr->atags ? am_true : am_false);
 	add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false));
 	add_2tup(hpp, szp, &res, am.e, am_true);
     }
@@ -5408,9 +5505,8 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *
 /* ----------------------------------------------------------------------- */
 
 static ERTS_INLINE void *
-do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
+do_erts_alcu_alloc(ErtsAlcType_t type, Allctr_t *allctr, Uint size)
 {
-    Allctr_t *allctr = (Allctr_t *) extra; 
     void *res;
 
     ASSERT(initialized);
@@ -5449,10 +5545,19 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
 
 void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
 {
+    Allctr_t *allctr = (Allctr_t *) extra;
     void *res;
+
     ASSERT(!"This is not thread safe");
-    res = do_erts_alcu_alloc(type, extra, size);
+
+    res = do_erts_alcu_alloc(type, allctr, size);
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+    }
+
     DEBUG_CHECK_ALIGNMENT(res);
+
     return res;
 }
 
@@ -5462,13 +5567,25 @@ void *
 erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size)
 {
     Allctr_t *allctr = (Allctr_t *) extra;
+    alcu_atag_t tag = 0;
     void *res;
+
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     erts_mtx_lock(&allctr->mutex);
-    res = do_erts_alcu_alloc(type, extra, size);
 
-    DEBUG_CHECK_ALIGNMENT(res);
+    res = do_erts_alcu_alloc(type, allctr, size);
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
 
     erts_mtx_unlock(&allctr->mutex);
+
+    DEBUG_CHECK_ALIGNMENT(res);
+
     return res;
 }
 
@@ -5478,6 +5595,7 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
 {
     ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
     int ix;
+    alcu_atag_t tag = 0;
     Allctr_t *allctr;
     void *res;
 
@@ -5487,11 +5605,19 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
 
     allctr = tspec->allctr[ix];
 
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     if (allctr->thread_safe)
 	erts_mtx_lock(&allctr->mutex);
 
     res = do_erts_alcu_alloc(type, allctr, size);
 
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
+
     if (allctr->thread_safe)
 	erts_mtx_unlock(&allctr->mutex);
 
@@ -5504,10 +5630,15 @@ void *
 erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
 {
     Allctr_t *pref_allctr;
+    alcu_atag_t tag = 0;
     void *res;
 
     pref_allctr = get_pref_allctr(extra);
 
+    if (pref_allctr->atags) {
+        tag = determine_alloc_tag(pref_allctr, type);
+    }
+
     if (pref_allctr->thread_safe)
 	erts_mtx_lock(&pref_allctr->mutex);
 
@@ -5523,12 +5654,15 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
 	res = do_erts_alcu_alloc(type, pref_allctr, size);
     }
 
+    if (pref_allctr->atags && res) {
+        set_alloc_tag(pref_allctr, res, tag);
+    }
+
     if (pref_allctr->thread_safe)
 	erts_mtx_unlock(&pref_allctr->mutex);
 
     DEBUG_CHECK_ALIGNMENT(res);
 
-
     return res;
 }
 
@@ -5537,10 +5671,9 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
 /* ------------------------------------------------------------------------- */
 
 static ERTS_INLINE void
-do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
+do_erts_alcu_free(ErtsAlcType_t type, Allctr_t *allctr, void *p,
 		  Carrier_t **busy_pcrr_pp)
 {
-    Allctr_t *allctr = (Allctr_t *) extra; 
     ASSERT(initialized);
 
     ASSERT(allctr);
@@ -5572,7 +5705,8 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
 
 void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
 {
-    do_erts_alcu_free(type, extra, p, NULL);
+    Allctr_t *allctr = (Allctr_t *) extra;
+    do_erts_alcu_free(type, allctr, p, NULL);
 }
 
 
@@ -5581,7 +5715,7 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p)
 {
     Allctr_t *allctr = (Allctr_t *) extra;
     erts_mtx_lock(&allctr->mutex);
-    do_erts_alcu_free(type, extra, p, NULL);
+    do_erts_alcu_free(type, allctr, p, NULL);
     erts_mtx_unlock(&allctr->mutex);
 }
 
@@ -5641,13 +5775,12 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
 
 static ERTS_INLINE void *
 do_erts_alcu_realloc(ErtsAlcType_t type,
-		     void *extra,
+		     Allctr_t *allctr,
 		     void *p,
 		     Uint size,
 		     Uint32 alcu_flgs,
 		     Carrier_t **busy_pcrr_pp)
 {
-    Allctr_t *allctr = (Allctr_t *) extra; 
     Block_t *blk;
     void *res;
 
@@ -5661,7 +5794,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
     ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
 
     if (!p) {
-	res = do_erts_alcu_alloc(type, extra, size);
+	res = do_erts_alcu_alloc(type, allctr, size);
 	INC_CC(allctr->calls.this_realloc);
 	DEC_CC(allctr->calls.this_alloc);
 	return res;
@@ -5670,7 +5803,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
 #if ALLOC_ZERO_EQ_NULL
     if (!size) {
 	ASSERT(p);
-	do_erts_alcu_free(type, extra, p, busy_pcrr_pp);
+	do_erts_alcu_free(type, allctr, p, busy_pcrr_pp);
 	INC_CC(allctr->calls.this_realloc);
 	DEC_CC(allctr->calls.this_free);
 	return NULL;
@@ -5755,19 +5888,29 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
 void *
 erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size)
 {
+    Allctr_t *allctr = (Allctr_t *)extra;
     void *res;
-    res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL);
+
+    res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
+
     DEBUG_CHECK_ALIGNMENT(res);
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+    }
+
     return res;
 }
 
 void *
 erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
 {
+    Allctr_t *allctr = (Allctr_t *)extra;
     void *res;
-    res = do_erts_alcu_alloc(type, extra, size);
+
+    res = do_erts_alcu_alloc(type, allctr, size);
     if (!res)
-	res = erts_alcu_realloc(type, extra, p, size);
+        res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
     else {
 	Block_t *blk;
 	size_t cpy_size;
@@ -5777,23 +5920,42 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
 	if (cpy_size > size)
 	    cpy_size = size;
 	sys_memcpy(res, p, cpy_size);
-	do_erts_alcu_free(type, extra, p, NULL);
+	do_erts_alcu_free(type, allctr, p, NULL);
     }
+
     DEBUG_CHECK_ALIGNMENT(res);
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+    }
+
     return res;
 }
 
 
-
 void *
 erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size)
 {
     Allctr_t *allctr = (Allctr_t *) extra;
+    alcu_atag_t tag = 0;
     void *res;
+
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     erts_mtx_lock(&allctr->mutex);
-    res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL);
+
+    res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
+
     erts_mtx_unlock(&allctr->mutex);
+
     DEBUG_CHECK_ALIGNMENT(res);
+
     return res;
 }
 
@@ -5801,11 +5963,17 @@ void *
 erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
 {
     Allctr_t *allctr = (Allctr_t *) extra;
+    alcu_atag_t tag = 0;
     void *res;
+
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     erts_mtx_lock(&allctr->mutex);
-    res = do_erts_alcu_alloc(type, extra, size);
+    res = do_erts_alcu_alloc(type, allctr, size);
     if (!res)
-        res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL);
+	res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
     else {
 	Block_t *blk;
 	size_t cpy_size;
@@ -5815,10 +5983,17 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
 	if (cpy_size > size)
 	    cpy_size = size;
 	sys_memcpy(res, p, cpy_size);
-	do_erts_alcu_free(type, extra, p, NULL);
+	do_erts_alcu_free(type, allctr, p, NULL);
     }
+
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
+
     erts_mtx_unlock(&allctr->mutex);
+
     DEBUG_CHECK_ALIGNMENT(res);
+
     return res;
 }
 
@@ -5829,6 +6004,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
 {
     ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
     int ix;
+    alcu_atag_t tag = 0;
     Allctr_t *allctr;
     void *res;
 
@@ -5838,11 +6014,19 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
 
     allctr = tspec->allctr[ix];
 
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     if (allctr->thread_safe)
 	erts_mtx_lock(&allctr->mutex);
 
     res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
 
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
+
     if (allctr->thread_safe)
 	erts_mtx_unlock(&allctr->mutex);
 
@@ -5857,6 +6041,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
 {
     ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
     int ix;
+    alcu_atag_t tag = 0;
     Allctr_t *allctr;
     void *res;
 
@@ -5866,14 +6051,16 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
 
     allctr = tspec->allctr[ix];
 
+    if (allctr->atags) {
+        tag = determine_alloc_tag(allctr, type);
+    }
+
     if (allctr->thread_safe)
 	erts_mtx_lock(&allctr->mutex);
 
     res = do_erts_alcu_alloc(type, allctr, size);
     if (!res) {
-	if (allctr->thread_safe)
-	    erts_mtx_unlock(&allctr->mutex);
-	res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size);
+        res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
     }
     else {
 	Block_t *blk;
@@ -5885,29 +6072,34 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
 	    cpy_size = size;
 	sys_memcpy(res, ptr, cpy_size);
 	do_erts_alcu_free(type, allctr, ptr, NULL);
-	if (allctr->thread_safe)
-	    erts_mtx_unlock(&allctr->mutex);
     }
 
+    if (allctr->atags && res) {
+        set_alloc_tag(allctr, res, tag);
+    }
+
+    if (allctr->thread_safe)
+        erts_mtx_unlock(&allctr->mutex);
+
     DEBUG_CHECK_ALIGNMENT(res);
 
     return res;
 }
 
 static ERTS_INLINE void *
-realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
+realloc_thr_pref(ErtsAlcType_t type, Allctr_t *pref_allctr, void *p, Uint size,
 		 int force_move)
 {
     void *res;
-    Allctr_t *pref_allctr, *used_allctr;
+    Allctr_t *used_allctr;
     UWord old_user_size;
     Carrier_t *busy_pcrr_p;
+    alcu_atag_t tag = 0;
     int retried;
 
-    if (!p)
-	return erts_alcu_alloc_thr_pref(type, extra, size);
-
-    pref_allctr = get_pref_allctr(extra);
+    if (pref_allctr->atags) {
+        tag = determine_alloc_tag(pref_allctr, type);
+    }
 
     if (pref_allctr->thread_safe)
 	erts_mtx_lock(&pref_allctr->mutex);
@@ -5936,6 +6128,11 @@ restart:
 	    retried = 1;
 	    goto restart;
 	}
+
+        if (pref_allctr->atags && res) {
+            set_alloc_tag(pref_allctr, res, tag);
+        }
+
 	if (pref_allctr->thread_safe)
 	    erts_mtx_unlock(&pref_allctr->mutex);
     }
@@ -5944,6 +6141,9 @@ restart:
 	if (!res)
 	    goto unlock_ts_return;
 	else {
+            if (pref_allctr->atags) {
+                set_alloc_tag(pref_allctr, res, tag);
+            }
 
 	    DEBUG_CHECK_ALIGNMENT(res);
 
@@ -5974,20 +6174,34 @@ restart:
 	}
     }
 
+    DEBUG_CHECK_ALIGNMENT(res);
+
     return res;
 }
 
 void *
 erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size)
 {
-    return realloc_thr_pref(type, extra, p, size, 0);
+    if (p) {
+        Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+        return realloc_thr_pref(type, pref_allctr, p, size, 0);
+    }
+
+    return erts_alcu_alloc_thr_pref(type, extra, size);
 }
 
 void *
 erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra,
 			      void *p, Uint size)
 {
-    return realloc_thr_pref(type, extra, p, size, 1);
+    if (p) {
+        Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+        return realloc_thr_pref(type, pref_allctr, p, size, 1);
+    }
+
+    return erts_alcu_alloc_thr_pref(type, extra, size);
 }
 
 
@@ -6071,6 +6285,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
 	allctr->t			= 0;
 
     allctr->ramv			= init->ramv;
+    allctr->atags                       = init->atags;
     allctr->main_carrier_size		= init->mmbcs;
 
 #if HAVE_ERTS_MSEG
@@ -6320,6 +6535,1072 @@ erts_alcu_init(AlcUInit_t *init)
     initialized = 1;
 }
 
+/* ------------------------------------------------------------------------- */
+
+/* Allocation histograms and carrier information is gathered by walking through
+ * all carriers associated with each allocator instance. This is done as
+ * aux_yield_work on the scheduler that owns each instance.
+ *
+ * Yielding is implemented by temporarily inserting a "dummy carrier" at the
+ * last position. It's permanently "busy" so it won't get picked up by someone
+ * else when in the carrier pool, and we never make the employer aware of it
+ * through callbacks so we can't accidentally allocate on it.
+ *
+ * Plain malloc/free is used to guarantee we won't allocate with the allocator
+ * we're scanning. */
+
+/* Yield between carriers once this many blocks have been processed. Note that
+ * a single carrier scan may exceed this figure. */
+#ifndef DEBUG
+    #define BLOCKSCAN_REDUCTIONS (8000)
+#else
+    #define BLOCKSCAN_REDUCTIONS (400)
+#endif
+
+/* Abort a single carrier scan after this many blocks to prevent really large
+ * MBCs from blocking forever. */
+#define BLOCKSCAN_BAILOUT_THRESHOLD (16000)
+
+typedef struct alcu_blockscan {
+    /* A per-scheduler list used when multiple scans have been queued. The
+     * current scanner will always run until completion/abort before moving on
+     * to the next. */
+    struct alcu_blockscan *scanner_queue;
+
+    Allctr_t *allocator;
+    Process *process;
+
+    int (*current_op)(struct alcu_blockscan *scanner);
+    int (*next_op)(struct alcu_blockscan *scanner);
+    int reductions;
+
+    ErtsAlcCPoolData_t *cpool_cursor;
+    CarrierList_t *current_clist;
+    Carrier_t *clist_cursor;
+    Carrier_t dummy_carrier;
+
+    /* Called if the process that started this job dies before we're done. */
+    void (*abort)(void *user_data);
+
+    /* Called on each carrier. The callback must return the number of blocks
+     * scanned to yield properly between carriers.
+     *
+     * Note that it's not possible to "yield back" into a carrier. */
+    int (*scan)(Allctr_t *, void *user_data, Carrier_t *);
+
+    /* Called when all carriers have been scanned. The callback may return
+     * non-zero to yield. */
+    int (*finish)(void *user_data);
+
+    void *user_data;
+} blockscan_t;
+
+static Carrier_t *blockscan_restore_clist_cursor(blockscan_t *state)
+{
+    Carrier_t *cursor = state->clist_cursor;
+
+    ASSERT(state->clist_cursor == (state->current_clist)->first ||
+           state->clist_cursor == &state->dummy_carrier);
+
+    if (cursor == &state->dummy_carrier) {
+        cursor = cursor->next;
+
+        unlink_carrier(state->current_clist, state->clist_cursor);
+    }
+
+    return cursor;
+}
+
+static void blockscan_save_clist_cursor(blockscan_t *state, Carrier_t *after)
+{
+    ASSERT(state->clist_cursor == (state->current_clist)->first ||
+           state->clist_cursor == &state->dummy_carrier);
+
+    state->clist_cursor = &state->dummy_carrier;
+
+    (state->clist_cursor)->next = after->next;
+    (state->clist_cursor)->prev = after;
+
+    relink_carrier(state->current_clist, state->clist_cursor);
+}
+
+static int blockscan_clist_yielding(blockscan_t *state)
+{
+    Carrier_t *cursor = blockscan_restore_clist_cursor(state);
+
+    if (ERTS_PROC_IS_EXITING(state->process)) {
+        return 0;
+    }
+
+    while (cursor) {
+        /* Skip dummy carriers inserted by another (concurrent) block scan.
+         * This can happen when scanning thread-safe allocators from multiple
+         * schedulers. */
+        if (CARRIER_SZ(cursor) > 0) {
+            int blocks_scanned = state->scan(state->allocator,
+                                             state->user_data,
+                                             cursor);
+
+            state->reductions -= blocks_scanned;
+
+            if (state->reductions <= 0) {
+                blockscan_save_clist_cursor(state, cursor);
+                return 1;
+            }
+        }
+
+        cursor = cursor->next;
+    }
+
+    return 0;
+}
+
+static ErtsAlcCPoolData_t *blockscan_restore_cpool_cursor(blockscan_t *state)
+{
+    ErtsAlcCPoolData_t *cursor;
+
+    cursor = cpool_aint2cpd(cpool_read(&(state->cpool_cursor)->next));
+
+    if (state->cpool_cursor == &state->dummy_carrier.cpool) {
+        cpool_delete(state->allocator, state->allocator, &state->dummy_carrier);
+    }
+
+    return cursor;
+}
+
+static void blockscan_save_cpool_cursor(blockscan_t *state,
+                                        ErtsAlcCPoolData_t *after)
+{
+    ErtsAlcCPoolData_t *dummy_carrier, *prev_carrier, *next_carrier;
+
+    dummy_carrier = &state->dummy_carrier.cpool;
+
+    next_carrier = cpool_aint2cpd(cpool_mod_mark(&after->next));
+    prev_carrier = cpool_aint2cpd(cpool_mod_mark(&next_carrier->prev));
+
+    cpool_init(&dummy_carrier->next, (erts_aint_t)next_carrier);
+    cpool_init(&dummy_carrier->prev, (erts_aint_t)prev_carrier);
+
+    cpool_set_mod_marked(&prev_carrier->next,
+                         (erts_aint_t)dummy_carrier,
+                         (erts_aint_t)next_carrier);
+    cpool_set_mod_marked(&next_carrier->prev,
+                         (erts_aint_t)dummy_carrier,
+                         (erts_aint_t)prev_carrier);
+
+    state->cpool_cursor = dummy_carrier;
+}
+
+static int blockscan_cpool_yielding(blockscan_t *state)
+{
+    ErtsAlcCPoolData_t *sentinel, *cursor;
+
+    sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+    cursor = blockscan_restore_cpool_cursor(state);
+
+    if (ERTS_PROC_IS_EXITING(state->process)) {
+        return 0;
+    }
+
+    while (cursor != sentinel) {
+        Carrier_t *carrier;
+        erts_aint_t exp;
+
+        /* When a deallocation happens on a pooled carrier it will be routed to
+         * its owner, so the only way to be sure that it isn't modified while
+         * scanning is to skip all carriers that aren't ours. The deallocations
+         * deferred to us will get handled when we're done. */
+        while (cursor->orig_allctr != state->allocator) {
+            cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+
+            if (cursor == sentinel) {
+                return 0;
+            }
+        }
+
+        carrier = ErtsContainerStruct(cursor, Carrier_t, cpool);
+        exp = erts_atomic_read_rb(&carrier->allctr);
+
+        if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+            ASSERT(state->allocator == (Allctr_t*)(exp & ~ERTS_CRR_ALCTR_FLG_MASK));
+            ASSERT(!(exp & ERTS_CRR_ALCTR_FLG_BUSY));
+
+            if (erts_atomic_cmpxchg_acqb(&carrier->allctr,
+                                         exp | ERTS_CRR_ALCTR_FLG_BUSY,
+                                         exp) == exp) {
+                /* Skip dummy carriers inserted by another (concurrent) block
+                 * scan. This can happen when scanning thread-safe allocators
+                 * from multiple schedulers. */
+                if (CARRIER_SZ(carrier) > 0) {
+                    int blocks_scanned = state->scan(state->allocator,
+                                                     state->user_data,
+                                                     carrier);
+
+                    state->reductions -= blocks_scanned;
+
+                    if (state->reductions <= 0) {
+                        blockscan_save_cpool_cursor(state, cursor);
+                        erts_atomic_set_relb(&carrier->allctr, exp);
+
+                        return 1;
+                    }
+                }
+
+                erts_atomic_set_relb(&carrier->allctr, exp);
+            }
+        }
+
+        cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+    }
+
+    return 0;
+}
+
+static int blockscan_yield_helper(blockscan_t *state,
+                                  int (*yielding_op)(blockscan_t*))
+{
+    /* Note that we don't check whether to abort here; only yielding_op knows
+     * whether the carrier is still in the list/pool. */
+
+    if ((state->allocator)->thread_safe) {
+        /* Locked scans have to be as short as possible. */
+        state->reductions = 1;
+
+        erts_mtx_lock(&(state->allocator)->mutex);
+    } else {
+        state->reductions = BLOCKSCAN_REDUCTIONS;
+    }
+
+    if (yielding_op(state)) {
+        state->next_op = state->current_op;
+    }
+
+    if ((state->allocator)->thread_safe) {
+        erts_mtx_unlock(&(state->allocator)->mutex);
+    }
+
+    return 1;
+}
+
+/* */
+
+static int blockscan_finish(blockscan_t *state)
+{
+    if (ERTS_PROC_IS_EXITING(state->process)) {
+        state->abort(state->user_data);
+        return 0;
+    }
+
+    state->current_op = blockscan_finish;
+
+    return state->finish(state->user_data);
+}
+
+static int blockscan_sweep_sbcs(blockscan_t *state)
+{
+    if (state->current_op != blockscan_sweep_sbcs) {
+        SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_SBC, state->allocator);
+        state->current_clist = &(state->allocator)->sbc_list;
+        state->clist_cursor = (state->current_clist)->first;
+    }
+
+    state->current_op = blockscan_sweep_sbcs;
+    state->next_op = blockscan_finish;
+
+    return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_mbcs(blockscan_t *state)
+{
+    if (state->current_op != blockscan_sweep_mbcs) {
+        SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+        state->current_clist = &(state->allocator)->mbc_list;
+        state->clist_cursor = (state->current_clist)->first;
+    }
+
+    state->current_op = blockscan_sweep_mbcs;
+    state->next_op = blockscan_sweep_sbcs;
+
+    return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_cpool(blockscan_t *state)
+{
+    if (state->current_op != blockscan_sweep_cpool) {
+        ErtsAlcCPoolData_t *sentinel;
+
+        SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+        sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+        state->cpool_cursor = sentinel;
+    }
+
+    state->current_op = blockscan_sweep_cpool;
+    state->next_op = blockscan_sweep_mbcs;
+
+    return blockscan_yield_helper(state, blockscan_cpool_yielding);
+}
+
+static int blockscan_get_specific_allocator(int allocator_num,
+                                            int sched_id,
+                                            Allctr_t **out)
+{
+    ErtsAllocatorInfo_t *ai;
+    Allctr_t *allocator;
+
+    ASSERT(allocator_num >= ERTS_ALC_A_MIN &&
+           allocator_num <= ERTS_ALC_A_MAX);
+    ASSERT(sched_id >= 0 && sched_id <= erts_no_schedulers);
+
+    ai = &erts_allctrs_info[allocator_num];
+
+    if (!ai->enabled || !ai->alloc_util) {
+        return 0;
+    }
+
+    if (!ai->thr_spec) {
+        if (sched_id != 0) {
+            /* Only thread-specific allocators can be scanned on a specific
+             * scheduler. */
+            return 0;
+        }
+
+        allocator = (Allctr_t*)ai->extra;
+        ASSERT(allocator->thread_safe);
+    } else {
+        ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t*)ai->extra;
+
+        ASSERT(sched_id < tspec->size);
+
+        allocator = tspec->allctr[sched_id];
+    }
+
+    *out = allocator;
+
+    return 1;
+}
+
+static void blockscan_sched_trampoline(void *arg)
+{
+    ErtsAlcuBlockscanYieldData *yield;
+    ErtsSchedulerData *esdp;
+    blockscan_t *scanner;
+
+    esdp = erts_get_scheduler_data();
+    scanner = (blockscan_t*)arg;
+
+    yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+    ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+    if (yield->last != NULL) {
+        blockscan_t *prev_scanner = yield->last;
+
+        ASSERT(prev_scanner->scanner_queue == NULL);
+
+        prev_scanner->scanner_queue = scanner;
+    } else {
+        yield->current = scanner;
+    }
+
+    scanner->scanner_queue = NULL;
+    yield->last = scanner;
+
+    erts_notify_new_aux_yield_work(esdp);
+}
+
+static void blockscan_dispatch(blockscan_t *scanner, Process *owner,
+                               Allctr_t *allocator, int sched_id)
+{
+    ASSERT(erts_get_scheduler_id() != 0);
+
+    if (sched_id == 0) {
+        /* Global instances are always handled on the current scheduler. */
+        sched_id = ERTS_ALC_GET_THR_IX();
+        ASSERT(allocator->thread_safe);
+    }
+
+    scanner->allocator = allocator;
+    scanner->process = owner;
+
+    erts_proc_inc_refc(scanner->process);
+
+    cpool_init_carrier_data(scanner->allocator, &scanner->dummy_carrier);
+    erts_atomic_init_nob(&(scanner->dummy_carrier).allctr,
+                         (erts_aint_t)allocator | ERTS_CRR_ALCTR_FLG_BUSY);
+
+    if (ERTS_ALC_IS_CPOOL_ENABLED(scanner->allocator)) {
+        scanner->next_op = blockscan_sweep_cpool;
+    } else {
+        scanner->next_op = blockscan_sweep_mbcs;
+    }
+
+    /* Aux yield jobs can only be set up while running on the scheduler that
+     * services them, so we move there before continuing.
+     *
+     * We can't drive the scan itself through this since the scheduler will
+     * always finish *all* misc aux work in one go which makes it impossible to
+     * yield. */
+    erts_schedule_misc_aux_work(sched_id, blockscan_sched_trampoline, scanner);
+}
+
+int erts_handle_yielded_alcu_blockscan(ErtsSchedulerData *esdp,
+                                       ErtsAlcuBlockscanYieldData *yield)
+{
+    blockscan_t *scanner = yield->current;
+
+    (void)esdp;
+
+    ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+    if (scanner) {
+        if (scanner->next_op(scanner)) {
+            return 1;
+        }
+
+        ASSERT(ERTS_PROC_IS_EXITING(scanner->process) ||
+               scanner->current_op == blockscan_finish);
+
+        yield->current = scanner->scanner_queue;
+
+        if (yield->current == NULL) {
+            ASSERT(scanner == yield->last);
+            yield->last = NULL;
+        }
+
+        erts_proc_dec_refc(scanner->process);
+
+        /* Plain free is intentional. */
+        free(scanner);
+
+        return yield->current != NULL;
+    }
+
+    return 0;
+}
+
+void erts_alcu_sched_spec_data_init(ErtsSchedulerData *esdp)
+{
+    ErtsAlcuBlockscanYieldData *yield;
+
+    yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+    yield->current = NULL;
+    yield->last = NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+static ERTS_INLINE int u64_log2(Uint64 v)
+{
+    static const int log2_tab64[64] = {
+        63,  0, 58,  1, 59, 47, 53,  2,
+        60, 39, 48, 27, 54, 33, 42,  3,
+        61, 51, 37, 40, 49, 18, 28, 20,
+        55, 30, 34, 11, 43, 14, 22,  4,
+        62, 57, 46, 52, 38, 26, 32, 41,
+        50, 36, 17, 19, 29, 10, 13, 21,
+        56, 45, 25, 31, 35, 16,  9, 12,
+        44, 24, 15,  8, 23,  7,  6,  5};
+
+    v |= v >> 1;
+    v |= v >> 2;
+    v |= v >> 4;
+    v |= v >> 8;
+    v |= v >> 16;
+    v |= v >> 32;
+
+    return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct hist_tree__ {
+    struct hist_tree__ *parent;
+    struct hist_tree__ *left;
+    struct hist_tree__ *right;
+
+    int is_red;
+
+    alcu_atag_t tag;
+    UWord histogram[1];
+} hist_tree_t;
+
+#define ERTS_RBT_PREFIX hist_tree
+#define ERTS_RBT_T hist_tree_t
+#define ERTS_RBT_KEY_T UWord
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) ((void)0)
+#define ERTS_RBT_IS_RED(T) ((T)->is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T))
+#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F)
+#define ERTS_RBT_GET_PARENT(T) ((T)->parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->tag)
+#define ERTS_RBT_IS_LT(KX, KY) (KX < KY)
+#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY)
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+typedef struct {
+    blockscan_t common;
+
+    ErtsIRefStorage iref;
+    Process *process;
+
+    hist_tree_rbt_yield_state_t hist_tree_yield;
+    hist_tree_t *hist_tree;
+    UWord hist_count;
+
+    UWord hist_slot_start;
+    int hist_slot_count;
+
+    UWord unscanned_size;
+
+    ErtsHeapFactory msg_factory;
+    int building_result;
+    Eterm result_list;
+} gather_ahist_t;
+
+static void gather_ahist_update(gather_ahist_t *state, UWord tag, UWord size)
+{
+    hist_tree_t *hist_node;
+    UWord size_interval;
+    int hist_slot;
+
+    hist_node = hist_tree_rbt_lookup(state->hist_tree, tag);
+
+    if (hist_node == NULL) {
+        /* Plain calloc is intentional. */
+        hist_node = (hist_tree_t*)calloc(1, sizeof(hist_tree_t) +
+                                            (state->hist_slot_count - 1) *
+                                            sizeof(hist_node->histogram[0]));
+        hist_node->tag = tag;
+
+        hist_tree_rbt_insert(&state->hist_tree, hist_node);
+        state->hist_count++;
+    }
+
+    size_interval = (size / state->hist_slot_start);
+    size_interval = u64_log2(size_interval + 1);
+
+    hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+    hist_node->histogram[hist_slot]++;
+}
+
+static int gather_ahist_scan(Allctr_t *allocator,
+                             void *user_data,
+                             Carrier_t *carrier)
+{
+    gather_ahist_t *state;
+    int blocks_scanned;
+    Block_t *block;
+
+    state = (gather_ahist_t*)user_data;
+    blocks_scanned = 1;
+
+    if (IS_SB_CARRIER(carrier)) {
+        alcu_atag_t tag;
+
+        block = SBC2BLK(allocator, carrier);
+        tag = GET_BLK_ATAG(block);
+
+        ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+        gather_ahist_update(state, tag, SBC_BLK_SZ(block));
+    } else {
+        UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+        ASSERT(IS_MB_CARRIER(carrier));
+
+        block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+        while (1) {
+            UWord block_size = MBC_BLK_SZ(block);
+
+            if (IS_ALLOCED_BLK(block)) {
+                alcu_atag_t tag = GET_BLK_ATAG(block);
+
+                ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+                gather_ahist_update(state, tag, block_size);
+            }
+
+            scanned_bytes += block_size;
+
+            if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+                state->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+                break;
+            } else if (IS_LAST_BLK(block)) {
+                break;
+            }
+
+            block = NXT_BLK(block);
+            blocks_scanned++;
+        }
+    }
+
+    return blocks_scanned;
+}
+
+static void gather_ahist_append_result(hist_tree_t *node, void *arg)
+{
+    gather_ahist_t *state = (gather_ahist_t*)arg;
+
+    Eterm histogram_tuple, tag_tuple;
+
+    Eterm *hp;
+    int ix;
+
+    ASSERT(state->building_result);
+
+    hp = erts_produce_heap(&state->msg_factory, 7 + state->hist_slot_count, 0);
+
+    hp[0] = make_arityval(state->hist_slot_count);
+
+    for (ix = 0; ix < state->hist_slot_count; ix++) {
+        hp[1 + ix] = make_small(node->histogram[ix]);
+    }
+
+    histogram_tuple = make_tuple(hp);
+    hp += 1 + state->hist_slot_count;
+
+    hp[0] = make_arityval(3);
+    hp[1] = ATAG_ID(node->tag);
+    hp[2] = alloc_type_atoms[ATAG_TYPE(node->tag)];
+    hp[3] = histogram_tuple;
+
+    tag_tuple = make_tuple(hp);
+    hp += 4;
+
+    state->result_list = CONS(hp, tag_tuple, state->result_list);
+
+    /* Plain free is intentional. */
+    free(node);
+}
+
+static void gather_ahist_send(gather_ahist_t *state)
+{
+    Eterm result_tuple, unscanned_size, task_ref;
+
+    Uint term_size;
+    Eterm *hp;
+
+    ASSERT((state->result_list == NIL) ^ (state->hist_count > 0));
+    ASSERT(state->building_result);
+
+    term_size = 4 + erts_iref_storage_heap_size(&state->iref);
+    term_size += IS_USMALL(0, state->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+    hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+    task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+        &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+    unscanned_size = bld_unstable_uint(&hp, NULL, state->unscanned_size);
+
+    hp[0] = make_arityval(3);
+    hp[1] = task_ref;
+    hp[2] = unscanned_size;
+    hp[3] = state->result_list;
+
+    result_tuple = make_tuple(hp);
+
+    erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+    erts_queue_message(state->process, 0, state->msg_factory.message,
+                       result_tuple, am_system);
+}
+
+static int gather_ahist_finish(void *arg)
+{
+    gather_ahist_t *state = (gather_ahist_t*)arg;
+
+    if (!state->building_result) {
+        ErtsMessage *message;
+        Uint minimum_size;
+        Eterm *hp;
+
+        /* {Ref, unscanned size, [{Tag, {Histogram}} | Rest]} */
+        minimum_size = 4 + erts_iref_storage_heap_size(&state->iref) +
+                       state->hist_count * (7 + state->hist_slot_count);
+
+        message = erts_alloc_message(minimum_size, &hp);
+        erts_factory_selfcontained_message_init(&state->msg_factory,
+                                                message, hp);
+
+        ERTS_RBT_YIELD_STAT_INIT(&state->hist_tree_yield);
+
+        state->result_list = NIL;
+        state->building_result = 1;
+    }
+
+    if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree,
+                                               &gather_ahist_append_result,
+                                               state,
+                                               &state->hist_tree_yield,
+                                               BLOCKSCAN_REDUCTIONS)) {
+        return 1;
+    }
+
+    gather_ahist_send(state);
+
+    return 0;
+}
+
+static void gather_ahist_destroy_result(hist_tree_t *node, void *arg)
+{
+    (void)arg;
+    free(node);
+}
+
+static void gather_ahist_abort(void *arg)
+{
+    gather_ahist_t *state = (gather_ahist_t*)arg;
+
+    if (state->building_result) {
+        erts_factory_undo(&state->msg_factory);
+    }
+
+    hist_tree_rbt_foreach_destroy(&state->hist_tree,
+                                  &gather_ahist_destroy_result,
+                                  NULL);
+}
+
+int erts_alcu_gather_alloc_histograms(Process *p, int allocator_num,
+                                      int sched_id, int hist_width,
+                                      UWord hist_start, Eterm ref)
+{
+    gather_ahist_t *gather_state;
+    blockscan_t *scanner;
+    Allctr_t *allocator;
+
+    ASSERT(is_internal_ref(ref));
+
+    if (!blockscan_get_specific_allocator(allocator_num,
+                                          sched_id,
+                                          &allocator)) {
+        return 0;
+    } else if (!allocator->atags) {
+        return 0;
+    }
+
+    ensure_atoms_initialized(allocator);
+
+    /* Plain calloc is intentional. */
+    gather_state = (gather_ahist_t*)calloc(1, sizeof(gather_ahist_t));
+    scanner = &gather_state->common;
+
+    scanner->abort = gather_ahist_abort;
+    scanner->scan = gather_ahist_scan;
+    scanner->finish = gather_ahist_finish;
+    scanner->user_data = gather_state;
+
+    erts_iref_storage_save(&gather_state->iref, ref);
+    gather_state->hist_slot_start = hist_start;
+    gather_state->hist_slot_count = hist_width;
+    gather_state->process = p;
+
+    blockscan_dispatch(scanner, p, allocator, sched_id);
+
+    return 1;
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct chist_node__ {
+    struct chist_node__ *next;
+
+    UWord carrier_size;
+    UWord unscanned_size;
+    UWord allocated_size;
+
+    /* BLOCKSCAN_BAILOUT_THRESHOLD guarantees we won't overflow this or the
+     * counters in the free block histogram. */
+    int allocated_count;
+    int flags;
+
+    int histogram[1];
+} chist_node_t;
+
+typedef struct {
+    blockscan_t common;
+
+    ErtsIRefStorage iref;
+    Process *process;
+
+    Eterm allocator_desc;
+
+    chist_node_t *info_list;
+    UWord info_count;
+
+    UWord hist_slot_start;
+    int hist_slot_count;
+
+    ErtsHeapFactory msg_factory;
+    int building_result;
+    Eterm result_list;
+} gather_cinfo_t;
+
+static int gather_cinfo_scan(Allctr_t *allocator,
+                             void *user_data,
+                             Carrier_t *carrier)
+{
+    gather_cinfo_t *state;
+    chist_node_t *node;
+    int blocks_scanned;
+    Block_t *block;
+
+    state = (gather_cinfo_t*)user_data;
+    node = calloc(1, sizeof(chist_node_t) +
+                     (state->hist_slot_count - 1) *
+                     sizeof(node->histogram[0]));
+    blocks_scanned = 1;
+
+    /* ERTS_CRR_ALCTR_FLG_BUSY is ignored since we've set it ourselves and it
+     * would be misleading to include it. */
+    node->flags = erts_atomic_read_rb(&carrier->allctr) &
+                  (ERTS_CRR_ALCTR_FLG_MASK & ~ERTS_CRR_ALCTR_FLG_BUSY);
+    node->carrier_size = CARRIER_SZ(carrier);
+
+    if (IS_SB_CARRIER(carrier)) {
+        UWord block_size;
+
+        block = SBC2BLK(allocator, carrier);
+        block_size = SBC_BLK_SZ(block);
+
+        node->allocated_size = block_size;
+        node->allocated_count = 1;
+    } else {
+        UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+        block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+        while (1) {
+            UWord block_size = MBC_BLK_SZ(block);
+
+            scanned_bytes += block_size;
+
+            if (IS_ALLOCED_BLK(block)) {
+                node->allocated_size += block_size;
+                node->allocated_count++;
+            } else {
+                UWord size_interval;
+                int hist_slot;
+
+                size_interval = (block_size / state->hist_slot_start);
+                size_interval = u64_log2(size_interval + 1);
+
+                hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+                node->histogram[hist_slot]++;
+            }
+
+            if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+                node->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+                break;
+            } else if (IS_LAST_BLK(block)) {
+                break;
+            }
+
+            block = NXT_BLK(block);
+            blocks_scanned++;
+        }
+    }
+
+    node->next = state->info_list;
+    state->info_list = node;
+    state->info_count++;
+
+    return blocks_scanned;
+}
+
+static void gather_cinfo_append_result(gather_cinfo_t *state,
+                                       chist_node_t *info)
+{
+    Eterm carrier_size, unscanned_size, allocated_size;
+    Eterm histogram_tuple, carrier_tuple;
+
+    Uint term_size;
+    Eterm *hp;
+    int ix;
+
+    ASSERT(state->building_result);
+
+    term_size = 11 + state->hist_slot_count;
+    term_size += IS_USMALL(0, info->carrier_size) ? 0 : BIG_UINT_HEAP_SIZE;
+    term_size += IS_USMALL(0, info->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+    term_size += IS_USMALL(0, info->allocated_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+    hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+    hp[0] = make_arityval(state->hist_slot_count);
+
+    for (ix = 0; ix < state->hist_slot_count; ix++) {
+        hp[1 + ix] = make_small(info->histogram[ix]);
+    }
+
+    histogram_tuple = make_tuple(hp);
+    hp += 1 + state->hist_slot_count;
+
+    carrier_size = bld_unstable_uint(&hp, NULL, info->carrier_size);
+    unscanned_size = bld_unstable_uint(&hp, NULL, info->unscanned_size);
+    allocated_size = bld_unstable_uint(&hp, NULL, info->allocated_size);
+
+    hp[0] = make_arityval(7);
+    hp[1] = state->allocator_desc;
+    hp[2] = carrier_size;
+    hp[3] = unscanned_size;
+    hp[4] = allocated_size;
+    hp[5] = make_small(info->allocated_count);
+    hp[6] = (info->flags & ERTS_CRR_ALCTR_FLG_IN_POOL) ? am_true : am_false;
+    hp[7] = histogram_tuple;
+
+    carrier_tuple = make_tuple(hp);
+    hp += 8;
+
+    state->result_list = CONS(hp, carrier_tuple, state->result_list);
+
+    free(info);
+}
+
+static void gather_cinfo_send(gather_cinfo_t *state)
+{
+    Eterm result_tuple, task_ref;
+
+    int term_size;
+    Eterm *hp;
+
+    ASSERT((state->result_list == NIL) ^ (state->info_count > 0));
+    ASSERT(state->building_result);
+
+    term_size = 3 + erts_iref_storage_heap_size(&state->iref);
+    hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+    task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+        &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+    hp[0] = make_arityval(2);
+    hp[1] = task_ref;
+    hp[2] = state->result_list;
+
+    result_tuple = make_tuple(hp);
+
+    erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+    erts_queue_message(state->process, 0, state->msg_factory.message,
+                       result_tuple, am_system);
+}
+
+static int gather_cinfo_finish(void *arg)
+{
+    gather_cinfo_t *state = (gather_cinfo_t*)arg;
+    int reductions = BLOCKSCAN_REDUCTIONS;
+
+    if (!state->building_result) {
+        ErtsMessage *message;
+        Uint minimum_size;
+        Eterm *hp;
+
+        /* {Ref, [{Carrier size, unscanned size, allocated size,
+         *         allocated block count, {Free block histogram}} | Rest]} */
+        minimum_size = 3 + erts_iref_storage_heap_size(&state->iref) +
+                       state->info_count * (11 + state->hist_slot_count);
+
+        message = erts_alloc_message(minimum_size, &hp);
+        erts_factory_selfcontained_message_init(&state->msg_factory,
+                                                message, hp);
+
+        state->result_list = NIL;
+        state->building_result = 1;
+    }
+
+    while (state->info_list) {
+        chist_node_t *current = state->info_list;
+        state->info_list = current->next;
+
+        gather_cinfo_append_result(state, current);
+
+        if (reductions-- <= 0) {
+            return 1;
+        }
+    }
+
+    gather_cinfo_send(state);
+
+    return 0;
+}
+
+static void gather_cinfo_abort(void *arg)
+{
+    gather_cinfo_t *state = (gather_cinfo_t*)arg;
+
+    if (state->building_result) {
+        erts_factory_undo(&state->msg_factory);
+    }
+
+    while (state->info_list) {
+        chist_node_t *current = state->info_list;
+        state->info_list = current->next;
+
+        free(current);
+    }
+}
+
+int erts_alcu_gather_carrier_info(struct process *p, int allocator_num,
+                                  int sched_id, int hist_width,
+                                  UWord hist_start, Eterm ref)
+{
+    gather_cinfo_t *gather_state;
+    blockscan_t *scanner;
+
+    const char *allocator_desc;
+    Allctr_t *allocator;
+
+    ASSERT(is_internal_ref(ref));
+
+    if (!blockscan_get_specific_allocator(allocator_num,
+                                          sched_id,
+                                          &allocator)) {
+        return 0;
+    }
+
+    allocator_desc = ERTS_ALC_A2AD(allocator_num);
+
+    /* Plain calloc is intentional. */
+    gather_state = (gather_cinfo_t*)calloc(1, sizeof(gather_cinfo_t));
+    scanner = &gather_state->common;
+
+    scanner->abort = gather_cinfo_abort;
+    scanner->scan = gather_cinfo_scan;
+    scanner->finish = gather_cinfo_finish;
+    scanner->user_data = gather_state;
+
+    gather_state->allocator_desc = erts_atom_put((byte *)allocator_desc,
+                                                 sys_strlen(allocator_desc),
+                                                 ERTS_ATOM_ENC_LATIN1, 1);
+    erts_iref_storage_save(&gather_state->iref, ref);
+    gather_state->hist_slot_start = hist_start * 2;
+    gather_state->hist_slot_count = hist_width;
+    gather_state->process = p;
+
+    blockscan_dispatch(scanner, p, allocator, sched_id);
+
+    return 1;
+}
+
 
 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
  * NOTE:  erts_alcu_test() is only supposed to be used for testing.          *
@@ -6441,6 +7722,7 @@ erts_alcu_verify_unused_ts(Allctr_t *allctr)
     erts_mtx_unlock(&allctr->mutex);
 }
 
+
 #ifdef DEBUG
 int is_sbc_blk(Block_t* blk)
 {