Merge branch 'rickard/alloc-opt/OTP-7775'

* rickard/alloc-opt/OTP-7775:
  Optimize memory allocation

Conflicts:
	erts/aclocal.m4
	erts/emulator/hipe/hipe_bif_list.m4
	erts/preloaded/ebin/erl_prim_loader.beam
	erts/preloaded/ebin/erlang.beam
	erts/preloaded/ebin/init.beam
	erts/preloaded/ebin/otp_ring0.beam
	erts/preloaded/ebin/prim_file.beam
	erts/preloaded/ebin/prim_inet.beam
	erts/preloaded/ebin/prim_zip.beam
	erts/preloaded/ebin/zlib.beam

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)].