Optimize memory allocation

A number of memory allocation optimizations have been implemented. Most
optimizations reduce contention caused by synchronization between
threads during allocation and deallocation of memory. Most notably:
* Synchronization of memory management in scheduler specific allocator
  instances has been rewritten to use lock-free synchronization.
* Synchronization of memory management in scheduler specific
  pre-allocators has been rewritten to use lock-free synchronization.
* The 'mseg_alloc' memory segment allocator now use scheduler specific
  instances instead of one instance. Apart from reducing contention
  this also ensures that memory allocators always create memory
  segments on the local NUMA node on a NUMA system.

5 files changed, 645 insertions, 10 deletions

diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index a77ea4f3be..bcb0257ed1 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -75,7 +75,8 @@
 	 smp_select/1,
 	 driver_select_use/1,
 	 thread_mseg_alloc_cache_clean/1,
-	 otp_9302/1]).
+	 otp_9302/1,
+	 thr_free_drv/1]).
 
 -export([bin_prefix/2]).
 
@@ -143,7 +144,8 @@ all() ->
      otp_6879, caller, many_events, missing_callbacks,
      smp_select, driver_select_use,
      thread_mseg_alloc_cache_clean,
-     otp_9302].
+     otp_9302,
+     thr_free_drv].
 
 groups() -> 
     [{timer, [],
@@ -1792,7 +1794,7 @@ driver_select_use0(Config) ->
 
 thread_mseg_alloc_cache_clean(Config) when is_list(Config) ->
     case {erlang:system_info(threads),
-	  erlang:system_info({allocator,mseg_alloc}),
+	  mseg_inst_info(0),
 	  driver_alloc_sbct()} of
 	{_, false, _} ->
 	    ?line {skipped, "No mseg_alloc"};
@@ -1804,13 +1806,13 @@ thread_mseg_alloc_cache_clean(Config) when is_list(Config) ->
 	    ?line {skipped, "driver_alloc() using too large single block threshold"};
 	{_, _, 0} ->
 	    ?line {skipped, "driver_alloc() using too low single block threshold"};
-	{true, MsegAllocInfo, SBCT} ->
+	{true, _MsegAllocInfo, SBCT} ->
 	    ?line DrvName = 'thr_alloc_drv',
 	    ?line Path = ?config(data_dir, Config),
 	    ?line erl_ddll:start(),
 	    ?line ok = load_driver(Path, DrvName),   
 	    ?line Port = open_port({spawn, DrvName}, []),
-	    ?line CCI = mseg_alloc_cci(MsegAllocInfo),
+	    ?line CCI = 1000,
 	    ?line ?t:format("CCI = ~p~n", [CCI]),
 	    ?line CCC = mseg_alloc_ccc(),
 	    ?line ?t:format("CCC = ~p~n", [CCC]),
@@ -1831,7 +1833,7 @@ mseg_alloc_cci(MsegAllocInfo) ->
     ?line CCI.
 
 mseg_alloc_ccc() ->
-    mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})).
+    mseg_alloc_ccc(mseg_inst_info(0)).
 
 mseg_alloc_ccc(MsegAllocInfo) ->
     ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo),
@@ -1841,7 +1843,7 @@ mseg_alloc_ccc(MsegAllocInfo) ->
     ?line GigaCCC*1000000000 + CCC.
 
 mseg_alloc_cached_segments() ->
-    mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})).
+    mseg_alloc_cached_segments(mseg_inst_info(0)).
 
 mseg_alloc_cached_segments(MsegAllocInfo) ->
     MemName = case is_halfword_vm() of
@@ -1859,6 +1861,13 @@ mseg_alloc_cached_segments(MsegAllocInfo) ->
 	= lists:keysearch(cached_segments, 1, SL),
     ?line CS.
 
+mseg_inst_info(I) ->
+    {value, {instance, I, Value}}
+	= lists:keysearch(I,
+			  2,
+			  erlang:system_info({allocator,mseg_alloc})),
+    Value.
+
 is_halfword_vm() ->
     case {erlang:system_info({wordsize, internal}),
 	  erlang:system_info({wordsize, external})} of
@@ -1914,6 +1923,38 @@ otp_9302(Config) when is_list(Config) ->
     ?line port_close(Port),
     ?line ok.
 
+thr_free_drv(Config) when is_list(Config) ->
+    ?line Path = ?config(data_dir, Config),
+    ?line erl_ddll:start(),
+    ?line ok = load_driver(Path, thr_free_drv),
+    ?line MemBefore = driver_alloc_size(),
+%    io:format("SID=~p", [erlang:system_info(scheduler_id)]),
+    ?line Port = open_port({spawn, thr_free_drv}, []),
+    ?line MemPeek = driver_alloc_size(),
+    ?line true = is_port(Port),
+    ?line ok = thr_free_drv_control(Port, 0),
+    ?line port_close(Port),
+    ?line MemAfter = driver_alloc_size(),
+    ?line io:format("MemPeek=~p~n", [MemPeek]),
+    ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]),
+    ?line MemBefore = MemAfter,
+    ?line case MemPeek of
+	      undefined -> ok;
+	      _ ->
+		  ?line true = MemPeek > MemBefore
+	  end,
+    ?line ok.
+
+thr_free_drv_control(Port, N) ->
+    case erlang:port_control(Port, 0, "") of
+	"done" ->
+	    ok;
+	"more" ->
+	    erlang:yield(),
+%	    io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]),
+	    thr_free_drv_control(Port, N+1)
+    end.
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% 		Utilities
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2077,3 +2118,33 @@ start_node(Config) when is_list(Config) ->
 
 stop_node(Node) ->
     ?t:stop_node(Node).
+
+wait_deallocations() ->
+    try
+	erts_debug:set_internal_state(wait, deallocations)
+    catch error:undef ->
+	    erts_debug:set_internal_state(available_internal_state, true),
+	    wait_deallocations()
+    end.
+
+driver_alloc_size() ->
+    wait_deallocations(),
+    case erlang:system_info({allocator_sizes, driver_alloc}) of
+	false ->
+	    undefined;
+	MemInfo ->
+	    CS = lists:foldl(
+		   fun ({instance, _, L}, Acc) ->
+			   {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L),
+			   {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
+			   {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
+			   [SBMBCS,MBCS,SBCS | Acc]
+		   end,
+		   [],
+		   MemInfo),
+	    lists:foldl(
+	      fun(L, Sz0) ->
+		      {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L),
+		      Sz0+Sz
+	      end, 0, CS)
+    end.
diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src
index 5b3ba1557e..62ab5169c0 100644
--- a/erts/emulator/test/driver_SUITE_data/Makefile.src
+++ b/erts/emulator/test/driver_SUITE_data/Makefile.src
@@ -12,7 +12,8 @@ MISC_DRVS =		outputv_drv@dll@ \
 			many_events_drv@dll@ \
 			missing_callback_drv@dll@ \
 			thr_alloc_drv@dll@ \
-			otp_9302_drv@dll@
+			otp_9302_drv@dll@ \
+			thr_free_drv@dll@
 
 SYS_INFO_DRVS = 	sys_info_1_0_drv@dll@ \
 			sys_info_1_1_drv@dll@ \
diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
new file mode 100644
index 0000000000..622a62ebea
--- /dev/null
+++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
@@ -0,0 +1,241 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 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
+ * 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%
+ */
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+#include "erl_driver.h"
+
+#define BLOCKS_PER_THREAD 100000
+#define NO_THREADS 10
+#define BLOCKS_PER_CTRL 1000
+
+typedef struct {
+    ErlDrvMutex *mtx;
+    ErlDrvCond *cnd;
+    int b;
+    int *go;
+    int *skip;
+    void *blocks[BLOCKS_PER_THREAD];
+} test_thread_data;
+
+typedef struct {
+    ErlDrvPort port;
+    int b;
+    int go;
+    int skip;
+    test_thread_data ttd[NO_THREADS+1];
+    ErlDrvTid tids[NO_THREADS+1];    
+} test_data;
+
+static ErlDrvData start(ErlDrvPort port, char *command);
+static void stop(ErlDrvData data);
+static int control(ErlDrvData drv_data, unsigned int command, char *buf,
+		   int len, char **rbuf, int rlen);
+
+static ErlDrvEntry thr_free_drv_entry = { 
+    NULL /* init */,
+    start,
+    stop,
+    NULL /* output */,
+    NULL /* ready_input */,
+    NULL /* ready_output */,
+    "thr_free_drv",
+    NULL /* finish */,
+    NULL /* handle */,
+    control,
+    NULL /* timeout */,
+    NULL /* outputv */,
+    NULL /* ready_async */,
+    NULL /* flush */,
+    NULL /* call */,
+    NULL /* event */,
+    ERL_DRV_EXTENDED_MARKER,
+    ERL_DRV_EXTENDED_MAJOR_VERSION,
+    ERL_DRV_EXTENDED_MINOR_VERSION,
+    ERL_DRV_FLAG_USE_PORT_LOCKING,
+    NULL /* handle2 */,
+    NULL /* handle_monitor */
+};
+
+DRIVER_INIT(thr_free_drv)
+{
+    return &thr_free_drv_entry;
+}
+
+void *
+test_thread(void *vttd)
+{
+    test_thread_data *ttd = (test_thread_data *) vttd;
+    int i, skip;
+
+    erl_drv_mutex_lock(ttd->mtx);
+
+    while (!*ttd->go)
+	erl_drv_cond_wait(ttd->cnd, ttd->mtx);
+    skip = *ttd->skip;
+    erl_drv_mutex_unlock(ttd->mtx);
+
+    if (!skip) {
+	for (i = 0; i < BLOCKS_PER_THREAD; i++)
+	    driver_free(ttd->blocks[i]);
+    }
+    return NULL;
+}
+
+ErlDrvData start(ErlDrvPort port, char *command)
+{
+    int join = 0, t, b, res;
+    test_thread_data *ttd;
+    test_data *td = driver_alloc(sizeof(test_data));
+    if (!td)
+	return ERL_DRV_ERROR_GENERAL;
+    ttd = td->ttd;
+    for (b = 0; b < BLOCKS_PER_THREAD; b++)
+	for (t = 0; t <= NO_THREADS; t++)
+	    ttd[t].blocks[b] = NULL;
+    ttd[0].mtx = NULL;
+    ttd[0].cnd = NULL;
+
+    for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+	for (t = 0; t <= NO_THREADS; t++) {
+	    ttd[t].blocks[b] = driver_alloc(1);
+	    if (ttd[t].blocks[b] == NULL)
+		goto fail;
+	}
+    }
+
+    td->b = -1;
+    td->go = 0;
+    td->skip = 0;
+
+    ttd[0].mtx = erl_drv_mutex_create("test_mutex");
+    if (!ttd[0].mtx)
+	goto fail;
+    ttd[0].cnd = erl_drv_cond_create("test_cnd");
+    if (!ttd[0].cnd)
+	goto fail;
+    ttd[0].go = &td->go;
+    ttd[0].skip = &td->skip;
+
+    for (t = 1; t <= NO_THREADS; t++) {
+	ttd[t].mtx = ttd[0].mtx;
+	ttd[t].cnd = ttd[0].cnd;
+	ttd[t].go = ttd[0].go;
+	ttd[t].skip = ttd[0].skip;
+	res = erl_drv_thread_create("test_thread",
+				    &td->tids[t],
+				    test_thread,
+				    &ttd[t],
+				    NULL);
+	if (res != 0)
+	    goto fail;
+	join = t;
+    }
+
+    td->port = port;
+
+    return (ErlDrvData) td;
+
+fail:
+
+    if (join) {
+	erl_drv_mutex_lock(ttd[0].mtx);
+	td->go = 1;
+	td->skip = 1;
+	erl_drv_cond_broadcast(ttd[0].cnd);
+	erl_drv_mutex_unlock(ttd[0].mtx);
+	for (t = 1; t <= join; t++)
+	    erl_drv_thread_join(td->tids[t], NULL);
+    }
+
+    if (ttd[0].mtx)
+	erl_drv_mutex_destroy(ttd[0].mtx);
+    if (ttd[0].cnd)
+	erl_drv_cond_destroy(ttd[0].cnd);
+
+    for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+	for (t = 0; t <= NO_THREADS; t++) {
+	    if (ttd[t].blocks[b] != NULL)
+		driver_free(ttd[t].blocks[b]);
+	}
+    }
+
+    return ERL_DRV_ERROR_GENERAL;
+}
+
+static void stop(ErlDrvData drv_data)
+{
+    test_data *td = (test_data *) drv_data;
+    int t, b;
+    for (t = 1; t <= NO_THREADS; t++)
+	erl_drv_thread_join(td->tids[t], NULL);
+    for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+	if (td->ttd[0].blocks[b])
+	    driver_free(td->ttd[0].blocks[b]);
+    }
+    erl_drv_mutex_destroy(td->ttd[0].mtx);
+    erl_drv_cond_destroy(td->ttd[0].cnd);
+    driver_free(td);
+}
+
+static int control(ErlDrvData drv_data, unsigned int command, char *buf,
+		   int len, char **rbuf, int rlen)
+{
+    test_data *td = (test_data *) drv_data;
+    char *result = "failure";
+    int i, b;
+    int res;
+    int result_len;
+
+    if (td->b == -1) {
+	erl_drv_mutex_lock(td->ttd[0].mtx);
+	td->go = 1;
+	erl_drv_cond_broadcast(td->ttd[0].cnd);
+	erl_drv_mutex_unlock(td->ttd[0].mtx);
+	td->b = 0;
+    }
+
+    for (i = 0, b = td->b; i < BLOCKS_PER_CTRL && b < BLOCKS_PER_THREAD; i++, b++) {
+	driver_free(td->ttd[0].blocks[b]);
+	td->ttd[0].blocks[b] = NULL;
+    }
+
+    td->b = b;
+    if (b >= BLOCKS_PER_THREAD)
+	result = "done";
+    else
+	result = "more";
+
+    result_len = strlen(result);
+    if (result_len <= rlen) {
+	memcpy(*rbuf, result, result_len);
+	return result_len;
+    }
+    else {
+	*rbuf = driver_alloc(result_len);
+	if (!*rbuf) {
+	    driver_failure_posix(td->port, ENOMEM);
+	    return 0;
+	}
+	else {
+	    memcpy(*rbuf, result, result_len);
+	    return result_len;
+	}
+    }
+}
diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl
index e0a7878bd8..879d2f61dd 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -62,16 +62,29 @@ init_per_suite(Config) when is_list(Config) ->
     Config.
 
 end_per_suite(Config) when is_list(Config) ->
+    catch erts_debug:set_internal_state(available_internal_state, false),
     Config.
 
 init_per_testcase(_Case, Config) ->
     Dog = ?t:timetrap(?t:minutes(15)),
+    %% Wait for deallocations to complete since we measure
+    %% runtime in test cases.
+    wait_deallocations(),
     [{watchdog, Dog}|Config].
 
 end_per_testcase(_Func, Config) ->
     Dog = ?config(watchdog, Config),
     ?t:timetrap_cancel(Dog).
 
+wait_deallocations() ->
+    try
+	erts_debug:set_internal_state(wait, deallocations)
+    catch
+	error:undef ->
+	    erts_debug:set_internal_state(available_internal_state, true),
+	    wait_deallocations()
+    end.
+
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index 9b782b35a2..0350eb671d 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -37,7 +37,7 @@
 	 init_per_group/2,end_per_group/2, 
 	 init_per_testcase/2, end_per_testcase/2]).
 
--export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]).
+-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1]).
 
 -define(DEFAULT_TIMEOUT, ?t:minutes(2)).
 
@@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
     [process_count, system_version, misc_smoke_tests,
-     heap_size, wordsize].
+     heap_size, wordsize, memory].
 
 groups() -> 
     [].
@@ -187,3 +187,312 @@ wordsize(Config) when is_list(Config) ->
 	Other ->
 	    exit({unexpected_wordsizes,Other})
     end.
+
+memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"];
+memory(Config) when is_list(Config) ->
+    %%
+    %% Verify that erlang:memory/0 and memory results in
+    %% crashdump produce are similar.
+    %%
+    %% erlang:memory/0 requests information from each scheduler
+    %% thread and puts the information together in erlang code
+    %% (erlang.erl).
+    %%
+    %% When a crash dump is written we cannot use the
+    %% erlang:memory/0 implementation. The crashdump implementation
+    %% is a pure C implementation inspecting all allocator instances
+    %% after the system has been blocked (erts_memory() in erl_alloc.c).
+    %%
+    %% Since we got two implementations, modifications can easily
+    %% cause them to produce different results.
+    %%
+    %% erts_debug:get_internal_state(memory) blocks the system and
+    %% execute the same code as the crash dump writing uses.
+    %%
+
+    erts_debug:set_internal_state(available_internal_state, true),
+    %% Use a large heap size on the controling process in
+    %% order to avoid changes in its heap size during
+    %% comparisons.
+    MinHeapSize = process_flag(min_heap_size, 1024*1024), 
+    Prio = process_flag(priority, max),
+    try
+	erlang:memory(), %% first call will init stat atoms
+	garbage_collect(), %% blow up heap
+	memory_test(Config)
+    catch
+	error:notsup -> {skipped, "erlang:memory() not supported"}
+    after
+	process_flag(min_heap_size, MinHeapSize),
+	process_flag(priority, Prio),
+	catch erts_debug:set_internal_state(available_internal_state, false)
+    end.
+
+memory_test(_Config) ->
+
+    MWs = spawn_mem_workers(),
+
+    DPs = mem_workers_call(MWs,
+			   fun () ->
+				   mapn(fun (_) ->
+						spawn(fun () ->
+							      receive
+							      after infinity ->
+								      ok
+							      end
+						      end)
+					end,
+					1000 div erlang:system_info(schedulers_online))
+			   end,
+			   []),
+    cmp_memory(MWs, "spawn procs"),
+
+    Ps = lists:flatten(DPs),
+
+    mem_workers_call(MWs, 
+		     fun () ->
+			     lists:foreach(fun (P) -> link(P) end, Ps)
+		     end,
+		     []),
+    cmp_memory(MWs, "link procs"),
+    mem_workers_call(MWs,
+		     fun () ->
+			     lists:foreach(fun (P) -> unlink(P) end, Ps)
+		     end,
+		     []),
+    cmp_memory(MWs, "unlink procs"),
+
+    DMs = mem_workers_call(MWs,
+			   fun () ->
+				   lists:map(fun (P) ->
+						     monitor(process, P)
+					     end, Ps)
+			   end,
+			   []),
+    cmp_memory(MWs, "monitor procs"),
+    Ms = lists:flatten(DMs),
+    mem_workers_call(MWs,
+		     fun () ->
+			     lists:foreach(fun (M) ->
+						   demonitor(M)
+					   end, Ms)
+		     end,
+		     []),
+    cmp_memory(MWs, "demonitor procs"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     lists:foreach(fun (P) ->
+						   P ! {a, "message", make_ref()}
+					   end, Ps)
+		     end,
+		     []),
+    cmp_memory(MWs, "message procs"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     Mons = lists:map(fun (P) ->
+						      exit(P, kill),
+						      monitor(process, P)
+					      end,
+					      Ps),
+			     lists:foreach(fun (Mon) ->
+						   receive
+						       {'DOWN', Mon, _, _, _} -> ok
+						   end
+					   end,
+					   Mons)
+		     end, []),
+    cmp_memory(MWs, "kill procs"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     put(binary_data,
+				 mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100))
+		     end,
+		     []),
+
+    cmp_memory(MWs, "store binary data"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     put(binary_data, false),
+			     garbage_collect()
+		     end,
+		     []),
+    cmp_memory(MWs, "release binary data"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+			     list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+			     list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id)))
+		     end,
+		     []),
+    cmp_memory(MWs, "new atoms"),
+
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     T = ets:new(?MODULE, []),
+			     ets:insert(T, {gurka, lists:seq(1,10000)}),
+			     ets:insert(T, {banan, lists:seq(1,1024)}),
+			     ets:insert(T, {appelsin, make_ref()}),
+			     put(ets_id, T)
+		     end,
+		     []),
+    cmp_memory(MWs, "store ets data"),
+
+    mem_workers_call(MWs,
+		     fun () ->
+			     ets:delete(get(ets_id)),
+			     put(ets_id, false)
+		     end,
+		     []),
+    cmp_memory(MWs, "remove ets data"),
+
+    lists:foreach(fun (MW) ->
+			  unlink(MW),
+			  Mon = monitor(process, MW),
+			  exit(MW, kill),
+			  receive
+			      {'DOWN', Mon, _, _, _} -> ok
+			  end
+		  end,
+		  MWs),
+    ok.
+
+mem_worker() ->
+    receive
+	{call, From, Fun, Args} ->
+	    From ! {reply, self(), apply(Fun, Args)},
+	    mem_worker();
+	{cast, _From, Fun, Args} ->
+	    apply(Fun, Args),
+	    mem_worker()
+    end.
+
+mem_workers_call(MWs, Fun, Args) ->
+    lists:foreach(fun (MW) ->
+			  MW ! {call, self(), Fun, Args}
+		  end,
+		  MWs),
+    lists:map(fun (MW) ->
+		      receive
+			  {reply, MW, Res} ->
+			      Res
+		      end
+	      end,
+	      MWs).
+
+mem_workers_cast(MWs, Fun, Args) ->
+    lists:foreach(fun (MW) ->
+			  MW ! {cast, self(), Fun, Args}
+		  end,
+		  MWs).
+
+spawn_mem_workers() ->
+    spawn_mem_workers(erlang:system_info(schedulers_online)).
+
+spawn_mem_workers(0) ->
+    [];
+spawn_mem_workers(N) ->
+    [spawn_opt(fun () -> mem_worker() end,
+	       [{scheduler, N rem erlang:system_info(schedulers_online) + 1},
+		link]) | spawn_mem_workers(N-1)].
+
+
+
+mem_get(X, Mem) ->
+    case lists:keyfind(X, 1, Mem) of
+	{X, Val} -> Val;
+	false -> false
+    end.
+
+cmp_memory(What, Mem1, Mem2, 1) ->
+    R1 = mem_get(What, Mem1),
+    R2 = mem_get(What, Mem2),
+    true = R1 == R2;
+cmp_memory(What, Mem1, Mem2, RelDiff) ->
+    %% We allow RealDiff diff
+    R1 = mem_get(What, Mem1),
+    R2 = mem_get(What, Mem2),
+    case R1 == R2 of
+	true ->
+	    ok;
+	false ->
+	    case R1 > R2 of
+		true ->
+		    true = R2*RelDiff > R1;
+		false ->
+		    true = R1*RelDiff > R2
+	    end
+    end.
+
+pos_int(Val) when Val >= 0 ->
+    Val;
+pos_int(Val) ->
+    exit({not_pos_int, Val}).
+
+check_sane_memory(Mem) ->
+    Tot = pos_int(mem_get(total, Mem)),
+    Proc = pos_int(mem_get(processes, Mem)),
+    ProcUsed = pos_int(mem_get(processes_used, Mem)),
+    Sys = pos_int(mem_get(system, Mem)),
+    Atom = pos_int(mem_get(atom, Mem)),
+    AtomUsed = pos_int(mem_get(atom_used, Mem)),
+    Bin = pos_int(mem_get(binary, Mem)),
+    Code = pos_int(mem_get(code, Mem)),
+    Ets = pos_int(mem_get(ets, Mem)),
+
+    Tot = Proc + Sys,
+    true = Sys > Atom + Bin + Code + Ets,
+    true = Proc >= ProcUsed,
+    true = Atom >= AtomUsed,
+
+    case mem_get(maximum, Mem) of
+	false -> ok;
+	Max -> true = pos_int(Max) >= Tot
+    end,
+    ok.
+
+cmp_memory(MWs, Str) ->
+    erlang:display(Str),
+    lists:foreach(fun (MW) -> garbage_collect(MW) end, MWs),
+    garbage_collect(),
+    erts_debug:set_internal_state(wait, deallocations),
+
+    EDM = erts_debug:get_internal_state(memory),
+    EM = erlang:memory(),
+
+    io:format("~s:~n"
+	      "erlang:memory() = ~p~n"
+	      "crash dump memory = ~p~n",
+	      [Str, EM, EDM]),
+
+    ?line check_sane_memory(EM),
+    ?line check_sane_memory(EDM),
+
+    %% We expect these to always give us exactly the same result
+
+    ?line cmp_memory(atom, EM, EDM, 1),
+    ?line cmp_memory(atom_used, EM, EDM, 1),
+    ?line cmp_memory(binary, EM, EDM, 1),
+    ?line cmp_memory(code, EM, EDM, 1),
+    ?line cmp_memory(ets, EM, EDM, 1),
+
+    %% Total, processes, processes_used, and system will seldom
+    %% give us exactly the same result since the two readings
+    %% aren't taken atomically.
+
+    ?line cmp_memory(total, EM, EDM, 1.05),
+    ?line cmp_memory(processes, EM, EDM, 1.05),
+    ?line cmp_memory(processes_used, EM, EDM, 1.05),
+    ?line cmp_memory(system, EM, EDM, 1.05),
+
+    ok.
+    
+mapn(_Fun, 0) ->
+    [];
+mapn(Fun, N) ->
+    [Fun(N) | mapn(Fun, N-1)].