Merge branch 'sverk/safe-purging/OTP-13122'

* sverk/safe-purging/OTP-13122:
  erts: Ignore unexpected messages to erts_code_purger
  erts: Optimize erlang:check_process_code
  erts: Refactor check_process_code/3
  erts: Make copy_literals more fail safe
  erts: Move copy_literals/2 from erlang to erts_internal
  erts: Make erlang:purge_module/1 safe
  erts: Refactor code:purge/1 and code:soft_purge/1
  erts: Introduce erts_code_purger

16 files changed, 485 insertions, 124 deletions

diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 8cf435905b..f4b806fae9 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -591,6 +591,7 @@ ifeq ($(TARGET),win32)
 PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
 PRELOAD_SRC = $(TARGET)/beams.rc
 $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+			$(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/init.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
@@ -600,11 +601,13 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/erlang.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam
+
 	$(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@
 else
 PRELOAD_OBJ = $(OBJDIR)/preload.o
 PRELOAD_SRC = $(TARGET)/preload.c
 $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+			$(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/init.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 6bb70cc5a7..a000935388 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -38,7 +38,7 @@
 #include "erl_thr_progress.h"
 
 static void set_default_trace_pattern(Eterm module);
-static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
+static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp);
 static void delete_code(Module* modp);
 static void decrement_refc(BeamCodeHeader*);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -426,7 +426,7 @@ check_old_code_1(BIF_ALIST_1)
 }
 
 Eterm
-erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
+erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp)
 {
     Module* modp;
     Eterm res;
@@ -441,7 +441,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
     if (!modp)
 	return am_false;
     erts_rlock_old_code(code_ix);
-    res = modp->old.code_hdr ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
+    res = (!modp->old.code_hdr ? am_false :
+           check_process_code(c_p, modp, flags, redsp));
     erts_runlock_old_code(code_ix);
 
     return res;
@@ -450,49 +451,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
 BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2)
 {
     int reds = 0;
+    Uint flags;
     Eterm res;
-    Eterm olist = BIF_ARG_2;
-    int allow_gc = 1;
 
     if (is_not_atom(BIF_ARG_1))
 	goto badarg;
 
-    while (is_list(olist)) {
-	Eterm *lp = list_val(olist);
-	Eterm opt = CAR(lp);
-	if (is_tuple(opt)) {
-	    Eterm* tp = tuple_val(opt);
-	    switch (arityval(tp[0])) {
-	    case 2:
-		switch (tp[1]) {
-		case am_allow_gc:
-		    switch (tp[2]) {
-		    case am_false:
-			allow_gc = 0;
-			break;
-		    case am_true:
-			allow_gc = 1;
-			break;
-		    default:
-			goto badarg;
-		    }
-		    break;
-		default:
-		    goto badarg;
-		}
-		break;
-	    default:
-		goto badarg;
-	    }
-	}
-	else
-	    goto badarg;
-	olist = CDR(lp);
+    if (is_not_small(BIF_ARG_2))
+        goto badarg;
+
+    flags = unsigned_val(BIF_ARG_2);
+    if (flags & ~ERTS_CPC_ALL) {
+        goto badarg;
     }
-    if (is_not_nil(olist))
-	goto badarg;
 
-    res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds);
+    res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds);
 
     ASSERT(is_value(res));
 
@@ -739,7 +712,7 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
 
 
 static Eterm
-check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
+check_process_code(Process* rp, Module* modp, Uint flags, int *redsp)
 {
     BeamInstr* start;
     char* literals;
@@ -852,6 +825,12 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	/* Check heap, stack etc... */
 	if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
 	    goto try_gc;
+        if (!(flags & ERTS_CPC_COPY_LITERALS)) {
+            /* Process ok. May contain old literals but we will be called
+             * again before module is purged.
+             */
+            return am_false;
+        }
 	if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
 	    rp->freason = EXC_NULL;
 	    rp->fvalue = NIL;
@@ -919,7 +898,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	if ((done_gc & need_gc) == need_gc)
 	    return am_true;
 
-	if (!allow_gc)
+	if (!(flags & ERTS_CPC_ALLOW_GC))
 	    return am_aborted;
 
 	need_gc &= ~done_gc;
@@ -1013,7 +992,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
 static void copy_literals_commit(void*);
 #endif
 
-copy_literals_t erts_clrange = {NULL, 0};
+copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE};
 
 /* copy literals
  *
@@ -1031,9 +1010,8 @@ copy_literals_t erts_clrange = {NULL, 0};
  */
 
 
-BIF_RETTYPE copy_literals_2(BIF_ALIST_2)
+BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
 {
-    Module* modp;
     ErtsCodeIndex code_ix;
     Eterm res = am_true;
 
@@ -1042,26 +1020,34 @@ BIF_RETTYPE copy_literals_2(BIF_ALIST_2)
     }
 
     if (!erts_try_seize_code_write_permission(BIF_P)) {
-	ERTS_BIF_YIELD2(bif_export[BIF_copy_literals_2], BIF_P, BIF_ARG_1, BIF_ARG_2);
+	ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2],
+                        BIF_P, BIF_ARG_1, BIF_ARG_2);
     }
 
     code_ix = erts_active_code_ix();
 
-    if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL || !modp->old.code_hdr) {
-        res = am_false;
-        goto done;
-    }
-
     if (BIF_ARG_2 == am_true) {
-        if (erts_clrange.ptr != NULL) {
+        Module* modp = erts_get_module(BIF_ARG_1, code_ix);
+        if (!modp || !modp->old.code_hdr) {
+            res = am_false;
+            goto done;
+        }
+        if (erts_clrange.ptr != NULL
+            && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) {
             res = am_aborted;
             goto done;
-       }
-        erts_clrange.ptr = (Eterm*) modp->old.code_hdr->literals_start;
-        erts_clrange.sz  = (Eterm*) modp->old.code_hdr->literals_end - erts_clrange.ptr;
+        }
+        erts_clrange.ptr = modp->old.code_hdr->literals_start;
+        erts_clrange.sz  = modp->old.code_hdr->literals_end - erts_clrange.ptr;
+        erts_clrange.pid = BIF_P->common.id;
     } else if (BIF_ARG_2 == am_false) {
+        if (erts_clrange.pid != BIF_P->common.id) {
+            res = am_false;
+            goto done;
+        }
         erts_clrange.ptr = NULL;
         erts_clrange.sz  = 0;
+        erts_clrange.pid = THE_NON_VALUE;
     }
 
 #ifdef ERTS_SMP
@@ -1094,7 +1080,12 @@ static void copy_literals_commit(void* null) {
 #endif /* ERTS_SMP */
 
 
-BIF_RETTYPE purge_module_1(BIF_ALIST_1)
+/* Do the actualy module purging and return:
+ * true for success
+ * false if no such old module
+ * BADARG if not an atom
+ */
+BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
 {
     ErtsCodeIndex code_ix;
     BeamInstr* code;
@@ -1108,7 +1099,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
     }
 
     if (!erts_try_seize_code_write_permission(BIF_P)) {
-	ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1);
+	ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1],
+                        BIF_P, BIF_ARG_1);
     }
 
     code_ix = erts_active_code_ix();
@@ -1118,7 +1110,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
      */
 
     if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
-	ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+        ERTS_BIF_PREP_RET(ret, am_false);
     }
     else {
 	erts_rwlock_old_code(code_ix);
@@ -1127,7 +1119,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
 	 * Any code to purge?
 	 */
 	if (!modp->old.code_hdr) {
-	    ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+            ERTS_BIF_PREP_RET(ret, am_false);
 	}
 	else {
 	    /*
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 0aee8681c6..1b8ae8cef5 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -125,7 +125,6 @@ bif erlang:process_flag/3
 bif erlang:process_info/1
 bif erlang:process_info/2
 bif erlang:processes/0
-bif erlang:purge_module/1
 bif erlang:put/2
 bif erlang:register/2
 bif erlang:registered/0
@@ -642,7 +641,8 @@ bif erts_debug:map_info/1
 # New in 19.0
 #
 
-bif erlang:copy_literals/2
+bif erts_internal:copy_literals/2
+bif erts_internal:purge_module/1
 bif binary:split/2
 bif binary:split/3
 bif erts_debug:size_shared/1
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 58ef09662c..42aca726bf 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -439,6 +439,29 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
     return res;
 }
 
+static Eterm
+erl_system_process_otp(Eterm parent_pid, char* modname)
+{
+    Eterm start_mod;
+    Process* parent;
+    ErlSpawnOpts so;
+    Eterm res;
+
+    start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1);
+    if (erts_find_function(start_mod, am_start, 0,
+			   erts_active_code_ix()) == NULL) {
+	erl_exit(5, "No function %s:start/0\n", modname);
+    }
+
+    parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN);
+
+    so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
+    res = erl_create_process(parent, start_mod, am_start, NIL, &so);
+    erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN);
+    return res;
+}
+
+
 Eterm
 erts_preloaded(Process* p)
 {
@@ -1234,6 +1257,7 @@ erl_start(int argc, char **argv)
     ErtsTimeWarpMode time_warp_mode;
     int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT;
     ErtsDbSpinCount db_spin_count = ERTS_DB_SPNCNT_NORMAL;
+    Eterm otp_ring0_pid;
 
     set_default_time_adj(&time_correction,
 			 &time_warp_mode);
@@ -2183,8 +2207,10 @@ erl_start(int argc, char **argv)
 
     erts_initialized = 1;
 
-    (void) erl_first_process_otp("otp_ring0", NULL, 0,
-				 boot_argc, boot_argv);
+    otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0,
+					  boot_argc, boot_argv);
+
+    (void) erl_system_process_otp(otp_ring0_pid, "erts_code_purger");
 
 #ifdef ERTS_SMP
     erts_start_schedulers();
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 2cdb98b2aa..9431bf98ec 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -10052,7 +10052,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
 	case ERTS_PSTT_CPC:
 	    st_res = erts_check_process_code(c_p,
 					     st->arg[0],
-					     st->arg[1] == am_true,
+                                             unsigned_val(st->arg[1]),
 					     &reds);
 	    if (is_non_value(st_res)) {
 		/* Needed gc, but gc was disabled */
@@ -10216,7 +10216,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
     case am_check_process_code:
 	if (is_not_atom(st->arg[0]))
 	    goto badarg;
-	if (st->arg[1] != am_true && st->arg[1] != am_false)
+	if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL))
 	    goto badarg;
 	noproc_res = am_false;
 	st->type = ERTS_PSTT_CPC;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 0bf5988244..3f5925765d 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -985,11 +985,15 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg);
 Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
 
 /* beam_bif_load.c */
-Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp);
+#define ERTS_CPC_ALLOW_GC      (1 << 0)
+#define ERTS_CPC_COPY_LITERALS (1 << 1)
+#define ERTS_CPC_ALL           (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS)
+Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp);
 
 typedef struct {
     Eterm *ptr;
     Uint   sz;
+    Eterm pid;
 } copy_literals_t;
 
 extern copy_literals_t erts_clrange;
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 68578c3a49..b6e38e4b5b 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
new file mode 100644
index 0000000000..227d96d4c8
--- /dev/null
+++ b/erts/preloaded/ebin/erts_code_purger.beam
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 4e1cb7f8a0..d3d990519d 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index a44b022931..b6d1df7bbc 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index 52034a0881..31383dda83 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -41,6 +41,7 @@ PRE_LOADED_ERL_MODULES = \
 	zlib \
 	prim_zip \
 	otp_ring0 \
+	erts_code_purger \
 	erlang \
 	erts_internal
 
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index d9dc9a1976..40d5aedd24 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -91,7 +91,7 @@
 -export([bit_size/1, bitsize/1, bitstring_to_list/1]).
 -export([bump_reductions/1, byte_size/1, call_on_load_function/1]).
 -export([cancel_timer/1, cancel_timer/2, check_old_code/1, check_process_code/2,
-	 check_process_code/3, copy_literals/2, crc32/1]).
+	 check_process_code/3, crc32/1]).
 -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]).
 -export([delete_element/2]).
 -export([delete_module/1, demonitor/1, demonitor/2, display/1]).
@@ -460,7 +460,7 @@ check_old_code(_Module) ->
       CheckResult :: boolean().
 check_process_code(Pid, Module) ->
     try
-	erlang:check_process_code(Pid, Module, [{allow_gc, true}])
+	erts_internal:check_process_code(Pid, Module, [{allow_gc, true}])
     catch
 	error:Error -> erlang:error(Error, [Pid, Module])
     end.
@@ -475,58 +475,11 @@ check_process_code(Pid, Module) ->
       CheckResult :: boolean() | aborted.
 check_process_code(Pid, Module, OptionList)  ->
     try
-	{Async, AllowGC} = get_cpc_opts(OptionList, sync, true),
-	case Async of
-	    {async, ReqId} ->
-		{priority, Prio} = erlang:process_info(erlang:self(),
-						       priority),
-		erts_internal:request_system_task(Pid,
-						  Prio,
-						  {check_process_code,
-						   ReqId,
-						   Module,
-						   AllowGC}),
-		async;
-	    sync ->
-		case Pid == erlang:self() of
-		    true ->
-			erts_internal:check_process_code(Module,
-							 [{allow_gc, AllowGC}]);
-		    false ->
-			{priority, Prio} = erlang:process_info(erlang:self(),
-							       priority),
-			ReqId = erlang:make_ref(),
-			erts_internal:request_system_task(Pid,
-							  Prio,
-							  {check_process_code,
-							   ReqId,
-							   Module,
-							   AllowGC}),
-			receive
-			    {check_process_code, ReqId, CheckResult} ->
-				CheckResult
-			end
-		end
-	end
+	erts_internal:check_process_code(Pid, Module, OptionList)
     catch
 	error:Error -> erlang:error(Error, [Pid, Module, OptionList])
     end.
 
-% gets async and allow_gc opts and verify valid option list
-get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) ->
-    get_cpc_opts(Options, AsyncTuple, AllowGC);
-get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) ->
-    get_cpc_opts(Options, Async, AllowGC);
-get_cpc_opts([], Async, AllowGC) ->
-    {Async, AllowGC}.
-
-%% copy_literals/2
--spec erlang:copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
-      Module :: module(),
-      Bool :: boolean().
-copy_literals(_Mod, _Bool) ->
-    erlang:nif_error(undefined).
-
 %% crc32/1
 -spec erlang:crc32(Data) -> non_neg_integer() when
       Data :: iodata().
@@ -1471,8 +1424,16 @@ processes() ->
 %% purge_module/1
 -spec purge_module(Module) -> true when
       Module :: atom().
-purge_module(_Module) ->
-    erlang:nif_error(undefined).
+purge_module(Module) when erlang:is_atom(Module) ->
+    case erts_code_purger:purge(Module) of
+	{false, _} ->
+	    erlang:error(badarg, [Module]);
+	{true, _} ->
+	    true
+    end;
+purge_module(Arg) ->
+    erlang:error(badarg, [Arg]).
+
 
 %% put/2
 -spec put(Key, Val) -> term() when
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index 8442aaf7e8..e53b6e5bab 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -27,6 +27,7 @@
 		erts_internal,
 		init,
 		otp_ring0,
+		erts_code_purger,
 		prim_eval,
 		prim_file,
 		prim_inet,
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
new file mode 100644
index 0000000000..a64860bec8
--- /dev/null
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -0,0 +1,299 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erts_code_purger).
+
+%% Purpose : Implement system process erts_code_purger
+%%           to handle code module purging.
+
+-export([start/0, purge/1, soft_purge/1]).
+
+-spec start() -> term().
+start() ->
+    register(erts_code_purger, self()),
+    process_flag(trap_exit, true),
+    loop().
+
+loop() ->
+    receive
+	{purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+	    Res = do_purge(Mod),
+	    From ! {reply, purge, Res, Ref};
+
+	{soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+	    Res = do_soft_purge(Mod),
+	    From ! {reply, soft_purge, Res, Ref};
+
+	_Other -> ignore
+    end,
+    loop().
+
+
+%% purge(Module)
+%%  Kill all processes running code from *old* Module, and then purge the
+%%  module. Return {WasOld, DidKill}:
+%%  {false, false} there was no old module to purge
+%%  {true, false} module purged, no process killed
+%%  {true, true} module purged, at least one process killed
+
+purge(Mod) when is_atom(Mod) ->
+    Ref = make_ref(),
+    erts_code_purger ! {purge, Mod, self(), Ref},
+    receive
+	{reply, purge, Result, Ref} ->
+	    Result
+    end.
+
+
+do_purge(Mod) ->
+    case erts_internal:copy_literals(Mod, true) of
+        false ->
+            {false, false};
+        true ->
+            DidKill = check_proc_code(erlang:processes(), Mod, true),
+            true = erts_internal:copy_literals(Mod, false),
+	    WasPurged = erts_internal:purge_module(Mod),
+            {WasPurged, DidKill}
+    end.
+
+%% soft_purge(Module)
+%% Purge old code only if no procs remain that run old code.
+%% Return true in that case, false if procs remain (in this
+%% case old code is not purged)
+
+soft_purge(Mod) ->
+    Ref = make_ref(),
+    erts_code_purger ! {soft_purge, Mod, self(), Ref},
+    receive
+	{reply, soft_purge, Result, Ref} ->
+	    Result
+    end.
+
+
+do_soft_purge(Mod) ->
+    case erts_internal:copy_literals(Mod, true) of
+	false ->
+	    true;
+	true ->
+	    DoPurge = check_proc_code(erlang:processes(), Mod, false),
+	    true = erts_internal:copy_literals(Mod, false),
+	    case DoPurge of
+		false ->
+		    false;
+		true ->
+		    erts_internal:purge_module(Mod),
+		    true
+	    end
+    end.
+
+%%
+%% check_proc_code(Pids, Mod, Hard) - Send asynchronous
+%%   requests to all processes to perform a check_process_code
+%%   operation. Each process will check their own state and
+%%   reply with the result. If 'Hard' equals
+%%   - true, processes that refer 'Mod' will be killed. If
+%%     any processes were killed true is returned; otherwise,
+%%     false.
+%%   - false, and any processes refer 'Mod', false will
+%%     returned; otherwise, true.
+%%
+%%   Requests will be sent to all processes identified by
+%%   Pids at once, but without allowing GC to be performed.
+%%   Check process code operations that are aborted due to
+%%   GC need, will be restarted allowing GC. However, only
+%%   ?MAX_CPC_GC_PROCS outstanding operation allowing GC at
+%%   a time will be allowed. This in order not to blow up
+%%   memory wise.
+%%
+%%   We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS
+%%   outstanding kills. This both in order to avoid flooding
+%%   our message queue with 'DOWN' messages and limiting the
+%%   amount of memory used to keep references to all
+%%   outstanding kills.
+%%
+
+%% We maybe should allow more than two outstanding
+%% GC requests, but for now we play it safe...
+-define(MAX_CPC_GC_PROCS, 2).
+-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10).
+
+-record(cpc_static, {hard, module, tag}).
+
+-record(cpc_kill, {outstanding = [],
+		   no_outstanding = 0,
+		   waiting = [],
+		   killed = false}).
+
+check_proc_code(Pids, Mod, Hard) ->
+    Tag = erlang:make_ref(),
+    CpcS = #cpc_static{hard = Hard,
+		       module = Mod,
+		       tag = Tag},
+    check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true).
+
+check_proc_code(#cpc_static{hard = true}, 0, 0, [],
+		#cpc_kill{outstanding = [], waiting = [], killed = Killed},
+		true) ->
+    %% No outstanding requests. We did a hard check, so result is whether or
+    %% not we killed any processes...
+    Killed;
+check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) ->
+    %% No outstanding requests and we did a soft check...
+    Success;
+check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0,
+		[], _KillState, false) ->
+    %% Failed soft check; just cleanup the remaining replies corresponding
+    %% to the requests we've sent...
+    {NoReq1, NoGcReq1} = receive
+			     {check_process_code, {Tag, _P, GC}, _Res} ->
+				 case GC of
+				     false -> {NoReq0-1, NoGcReq0};
+				     true -> {NoReq0, NoGcReq0-1}
+				 end
+			 end,
+    check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false);
+check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0,
+		KillState0, Success) ->
+
+    %% Check if we should request a GC operation
+    {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of
+			      GcOpAllowed when GcOpAllowed == false;
+					       NeedGC0 == [] ->
+				  {NoGcReq0, NeedGC0};
+			      _ ->
+				  {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)}
+			  end,
+
+    %% Wait for a cpc reply or 'DOWN' message
+    {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag,
+							   NoReq0,
+							   NoGcReq1,
+							   KillState0),
+
+    %% Check the result of the reply
+    case Result of
+	aborted ->
+	    %% Operation aborted due to the need to GC in order to
+	    %% determine if the process is referring the module.
+	    %% Schedule the operation for restart allowing GC...
+	    check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1,
+			    Success);
+	false ->
+	    %% Process not referring the module; done with this process...
+	    check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1,
+			    Success);
+	true ->
+	    %% Process referring the module...
+	    case CpcS#cpc_static.hard of
+		false ->
+		    %% ... and soft check. The whole operation failed so
+		    %% no point continuing; clean up and fail...
+		    check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1,
+				    false);
+		true ->
+		    %% ... and hard check; schedule kill of it...
+		    check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+				    cpc_sched_kill(Pid, KillState1), Success)
+	    end;
+	'DOWN' ->
+	    %% Handled 'DOWN' message
+	    check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+			    KillState1, Success)
+    end.
+
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) ->
+    receive
+	{check_process_code, {Tag, Pid, GC}, Res} ->
+	    cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+    end;
+cpc_recv(Tag, NoReq, NoGcReq,
+	 #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) ->
+    receive
+	{'DOWN', R, process, _, _} when R == R0;
+					R == R1;
+					R == R2;
+					R == R3;
+					R == R4 ->
+	    cpc_handle_down(NoReq, NoGcReq, R, KillState);
+	{check_process_code, {Tag, Pid, GC}, Res} ->
+	    cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+    end;
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) ->
+    receive
+	{'DOWN', R, process, _, _} ->
+	    cpc_handle_down(NoReq, NoGcReq, R, KillState);
+	{check_process_code, {Tag, Pid, GC}, Res} ->
+	    cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+    end.
+
+cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs,
+					     no_outstanding = N} = KillState) ->
+    {NoReq, NoGcReq, undefined, 'DOWN',
+     cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs),
+					       no_outstanding = N-1})}.
+
+cpc_list_rm(R, [R|Rs]) ->
+    Rs;
+cpc_list_rm(R0, [R1|Rs]) ->
+    [R1|cpc_list_rm(R0, Rs)].
+
+cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) ->
+    {NoReq-1, NoGcReq, Pid, Res, KillState};
+cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) ->
+    {NoReq, NoGcReq-1, Pid, Res, KillState}.
+
+cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) ->
+    KillState;
+cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs,
+				 no_outstanding = N,
+				 waiting = [P|Ps]} = KillState) ->
+    R = erlang:monitor(process, P),
+    exit(P, kill),
+    KillState#cpc_kill{outstanding = [R|Rs],
+		       no_outstanding = N+1,
+		       waiting = Ps,
+		       killed = true}.
+
+cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState)
+  when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS ->
+    KillState#cpc_kill{waiting = [Pid|Pids]};
+cpc_sched_kill(Pid,
+	       #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) ->
+    R = erlang:monitor(process, Pid),
+    exit(Pid, kill),
+    KillState#cpc_kill{outstanding = [R|Rs],
+		       no_outstanding = N+1,
+		       killed = true}.
+
+cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) ->
+    erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
+						{allow_gc, AllowGc},
+						{copy_literals, true}]).
+
+cpc_request_gc(CpcS, [Pid|Pids]) ->
+    cpc_request(CpcS, Pid, true),
+    Pids.
+
+cpc_init(_CpcS, [], NoReqs) ->
+    NoReqs;
+cpc_init(CpcS, [Pid|Pids], NoReqs) ->
+    cpc_request(CpcS, Pid, false),
+    cpc_init(CpcS, Pids, NoReqs+1).
+
+% end of check_proc_code() implementation.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 426749264f..84dedab930 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -37,7 +37,9 @@
 
 -export([request_system_task/3]).
 
--export([check_process_code/2]).
+-export([check_process_code/3]).
+-export([copy_literals/2]).
+-export([purge_module/1]).
 
 -export([flush_monitor_messages/3]).
 
@@ -47,6 +49,9 @@
 
 -export([is_system_process/1]).
 
+%% Auto import name clash
+-export([check_process_code/2]).
+
 %%
 %% Await result of send to port
 %%
@@ -197,11 +202,80 @@ port_info(_Result, _Item) ->
 request_system_task(_Pid, _Prio, _Request) ->
     erlang:nif_error(undefined).
 
--spec check_process_code(Module, OptionList) -> boolean() when
+-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)).
+-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)).
+
+-spec check_process_code(Module, Flags) -> boolean() when
+      Module :: module(),
+      Flags :: non_neg_integer().
+check_process_code(_Module, _Flags) ->
+    erlang:nif_error(undefined).
+
+-spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when
+      Pid :: pid(),
+      Module :: module(),
+      RequestId :: term(),
+      Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()},
+      OptionList :: [Option],
+      CheckResult :: boolean() | aborted.
+check_process_code(Pid, Module, OptionList)  ->
+    {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC),
+    case Async of
+	{async, ReqId} ->
+	    {priority, Prio} = erlang:process_info(erlang:self(),
+						   priority),
+	    erts_internal:request_system_task(Pid,
+					      Prio,
+					      {check_process_code,
+					       ReqId,
+					       Module,
+					       Flags}),
+	    async;
+	sync ->
+	    case Pid == erlang:self() of
+		true ->
+		    erts_internal:check_process_code(Module, Flags);
+		false ->
+		    {priority, Prio} = erlang:process_info(erlang:self(),
+							   priority),
+		    ReqId = erlang:make_ref(),
+		    erts_internal:request_system_task(Pid,
+						      Prio,
+						      {check_process_code,
+						       ReqId,
+						       Module,
+						       Flags}),
+		    receive
+			{check_process_code, ReqId, CheckResult} ->
+			    CheckResult
+		    end
+	    end
+    end.
+
+% gets async and flag opts and verify valid option list
+get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) ->
+    get_cpc_opts(Options, AsyncTuple, Flags);
+get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) ->
+    get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC));
+get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) ->
+    get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit));
+get_cpc_opts([], Async, Flags) ->
+    {Async, Flags}.
+
+cpc_flags(OldFlags, Bit, true) ->
+    OldFlags bor Bit;
+cpc_flags(OldFlags, Bit, false) ->
+    OldFlags band (bnot Bit).
+
+-spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
       Module :: module(),
-      Option :: {allow_gc, boolean()},
-      OptionList :: [Option].
-check_process_code(_Module, _OptionList) ->
+      Bool :: boolean().
+copy_literals(_Mod, _Bool) ->
+    erlang:nif_error(undefined).
+
+-spec purge_module(Module) -> boolean() when
+      Module :: module().
+purge_module(_Module) ->
     erlang:nif_error(undefined).
 
 %% term compare where integer() < float() = true
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 383c4a1ec6..ed65c57c0d 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -636,9 +636,9 @@ unload(_) ->
     do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
 
 do_unload([M|Mods]) ->
-    catch erlang:purge_module(M),
+    catch erts_internal:purge_module(M),
     catch erlang:delete_module(M),
-    catch erlang:purge_module(M),
+    catch erts_internal:purge_module(M),
     do_unload(Mods);
 do_unload([]) ->
     purge_all_hipe_refs(),