Fix purge of code

Ensure that we cannot get any dangling pointers into code that
has been purged. This is done by a two phase purge. At first
phase all fun entries pointing into the code to purge are marked
for purge. All processes trying to call these funs will be suspended
and by this we avoid getting new direct references into the code.
When all processes has been checked, these processes are resumed.

The new purge strategy now also completely ignore the existence of
indirect references to the code (funs). If such exist, they will
cause bad fun exceptions to the caller, but will not prevent a
soft purge or cause a kill of a process having such live references
during a hard purge. This since it is impossible to give any
guarantees that no processes in the system have such indirect
references. Even when the system is completely clean from such
references, new ones can appear via distribution and/or disk.

11 files changed, 489 insertions, 281 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index dd37c682b1..ace3dc5230 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -65,6 +65,7 @@ atom undefined_lambda
 atom DOWN='DOWN'
 atom UP='UP'
 atom EXIT='EXIT'
+atom abort
 atom aborted
 atom abs_path
 atom absoluteURI
@@ -165,6 +166,7 @@ atom commandv
 atom compact
 atom compat_rel
 atom compile
+atom complete
 atom compressed
 atom config_h
 atom convert_time_unit
@@ -236,6 +238,7 @@ atom erlang
 atom ERROR='ERROR'
 atom error_handler
 atom error_logger
+atom erts_code_purger
 atom erts_internal
 atom ets
 atom ETS_TRANSFER='ETS-TRANSFER'
@@ -487,6 +490,7 @@ atom pause
 atom pending
 atom pending_driver
 atom pending_process
+atom pending_purge_lambda
 atom pending_reload
 atom permanent
 atom pid
@@ -496,6 +500,7 @@ atom port_count
 atom port_limit
 atom port_op
 atom positive
+atom prepare
 atom print
 atom priority
 atom private
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 484198b339..2413ccdba9 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -37,6 +37,20 @@
 #include "erl_bits.h"
 #include "erl_thr_progress.h"
 
+static struct {
+    Eterm module;
+    erts_smp_mtx_t mtx;
+    Export *pending_purge_lambda;
+    Eterm *sprocs;
+    Eterm def_sprocs[10];
+    Uint sp_size;
+    Uint sp_ix;
+    ErlFunEntry **funs;
+    ErlFunEntry *def_funs[10];
+    Uint fe_size;
+    Uint fe_ix;
+} purge_state;
+
 Process *erts_code_purger = NULL;
 
 ErtsLiteralArea *erts_copy_literal_area = NULL;
@@ -62,6 +76,27 @@ static void delete_code(Module* modp);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 
+static void
+init_purge_state(void)
+{
+    purge_state.module = THE_NON_VALUE;
+
+    erts_smp_mtx_init(&purge_state.mtx, "purge_state");
+
+    purge_state.pending_purge_lambda =
+	erts_export_put(am_erts_code_purger, am_pending_purge_lambda, 3);
+
+    purge_state.sprocs = &purge_state.def_sprocs[0];
+    purge_state.sp_size = sizeof(purge_state.def_sprocs);
+    purge_state.sp_size /= sizeof(purge_state.def_sprocs[0]);
+    purge_state.sp_ix = 0;
+
+    purge_state.funs = &purge_state.def_funs[0];
+    purge_state.fe_size = sizeof(purge_state.def_funs);
+    purge_state.fe_size /= sizeof(purge_state.def_funs[0]);
+    purge_state.fe_ix = 0;
+}
+
 void
 erts_beam_bif_load_init(void)
 {
@@ -70,6 +105,8 @@ erts_beam_bif_load_init(void)
     release_literal_areas.first = NULL;
     release_literal_areas.last = NULL;
 #endif
+
+    init_purge_state();
 }
 
 BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
@@ -776,6 +813,8 @@ set_default_trace_pattern(Eterm module)
     }
 }
 
+#ifndef ERTS_NEW_PURGE_STRATEGY
+
 static ERTS_INLINE int
 check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
 {
@@ -790,6 +829,8 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
     return 0;
 }
 
+#endif
+
 static Uint hfrag_literal_size(Eterm* start, Eterm* end,
                                char* lit_start, Uint lit_size);
 static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
@@ -926,7 +967,6 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
 	hfrag = erts_message_to_heap_frag(msgp);
 	for (; hfrag; hfrag = hfrag->next) {
 	    Eterm *hp, *hp_end;
-	    ASSERT(!check_mod_funs(c_p, &hfrag->off_heap, mod_start, mod_size));
 
 	    *redsp += 1;
 
@@ -966,9 +1006,8 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
     char* mod_start;
     Uint mod_size;
     Eterm* sp;
-    int done_gc = 0;
-    ErtsMessage *msgp;
-    ErlHeapFragment *hfrag;
+
+    *redsp += 1;
 
     /*
      * Pick up limits for the module.
@@ -985,6 +1024,8 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 	return am_true;
     }
 
+    *redsp += (STACK_START(rp) - rp->stop) / 32;
+
     /*
      * Check all continuation pointers stored on the stack.
      */
@@ -1021,82 +1062,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 	}
     }
 
-    /*
-     * Message queue can contains funs.
-     */
-
-    erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
-    ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
-    erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
-
-    for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
-	ErlHeapFragment *hf;
-	if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
-	    hfrag = &msgp->hfrag;
-	else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
-	    hfrag = msgp->data.heap_frag;
-	else
-	    continue;
-
-	for (hf = hfrag; hf; hf = hf->next) {
-	    if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
-		return am_true;
-	}
-    }
-
-    while (1) {
-
-	/* Check heap, stack etc... */
-	if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
-	    goto try_gc;
-
-#ifdef DEBUG
-	/* Check heap fragments */
-	for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) {
-	    /* Off heap lists should already have been moved into process */
-	    ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
-	}
-
-	/*
-	 * Message buffer fragments (matched messages) 
-         *  - off heap lists should already have been moved into
-         *    process off heap structure.
-         *  - Check for literals
-	 */
-	for (msgp = rp->msg_frag; msgp; msgp = msgp->next) {
-            hfrag = erts_message_to_heap_frag(msgp);
-	    for (; hfrag; hfrag = hfrag->next) {
-		Eterm *hp, *hp_end;
-		ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
-	    }
-	}
-#endif
-
-	return am_false;
-
-    try_gc:
-
-	if (rp->flags & F_DISABLE_GC) {
-	    /*
-	     * Cannot proceed. Process has disabled gc in order to
-	     * safely leave inconsistent data on the heap and/or
-	     * off heap lists. Need to wait for gc to be enabled
-	     * again.
-	     */ 
-	    return THE_NON_VALUE;
-	}
-
-	if (done_gc)
-	    return am_true;
-
-	if (!(flags & ERTS_CPC_ALLOW_GC))
-	    return am_aborted;
-
-	FLAGS(rp) |= F_NEED_FULLSWEEP;
-	*redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls);
-	done_gc = 1;
-    }
-
+    return am_false;
 }
 
 #else /* !ERTS_NEW_PURGE_STRATEGY, i.e, old style purge... */
@@ -1470,12 +1436,11 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
     }
 }
 
-#undef in_area
-
 #ifdef ERTS_NEW_PURGE_STRATEGY
 
 ErtsThrPrgrLaterOp later_literal_area_switch;
 
+#ifdef ERTS_SMP
 static void
 complete_literal_area_switch(void *unused)
 {
@@ -1484,6 +1449,7 @@ complete_literal_area_switch(void *unused)
     erts_resume(p, ERTS_PROC_LOCK_STATUS);
     erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
 }
+#endif
 
 #endif /* ERTS_NEW_PURGE_STRATEGY */
 
@@ -1533,216 +1499,376 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
 #endif /* ERTS_NEW_PURGE_STRATEGY */
 }
 
-#ifndef ERTS_NEW_PURGE_STRATEGY
+void
+erts_purge_state_add_fun(ErlFunEntry *fe)
+{
+    ASSERT(is_value(purge_state.module));
+    if (purge_state.fe_ix >= purge_state.fe_size) {
+	ErlFunEntry **funs;
+	purge_state.fe_size += 100;
+	funs = erts_alloc(ERTS_ALC_T_PURGE_DATA,
+			  sizeof(ErlFunEntry *)*purge_state.fe_size);
+	sys_memcpy((void *) funs,
+		   (void *) purge_state.funs,
+		   purge_state.fe_ix*sizeof(ErlFunEntry *));
+	if (purge_state.funs != &purge_state.def_funs[0])
+	    erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.funs);
+	purge_state.funs = funs;
+    }
+    purge_state.funs[purge_state.fe_ix++] = fe;
+}
 
-#ifdef ERTS_SMP
-static void copy_literals_commit(void*);
-#endif
+Export *
+erts_suspend_process_on_pending_purge_lambda(Process *c_p)
+{
+    erts_smp_mtx_lock(&purge_state.mtx);
+    if (is_value(purge_state.module)) {
+	/*
+	 * The process c_p is about to call a fun in the code
+	 * that we are trying to purge. Suspend it and call
+	 * erts_code_purger:pending_purge_lambda/3. The process
+	 * will be resumed when the purge completes or aborts,
+	 * and will then try to do the call again.
+	 */
+	if (purge_state.sp_ix >= purge_state.sp_size) {
+	    Eterm *sprocs;
+	    purge_state.sp_size += 100;
+	    sprocs = erts_alloc(ERTS_ALC_T_PURGE_DATA,
+				(sizeof(ErlFunEntry *)
+				 * purge_state.sp_size));
+	    sys_memcpy((void *) sprocs,
+		       (void *) purge_state.sprocs,
+		       purge_state.sp_ix*sizeof(ErlFunEntry *));
+	    if (purge_state.sprocs != &purge_state.def_sprocs[0])
+		erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.sprocs);
+	    purge_state.sprocs = sprocs;
+	}
+	purge_state.sprocs[purge_state.sp_ix++] = c_p->common.id;
+	erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+	ERTS_VBUMP_ALL_REDS(c_p);
+    }
+    erts_smp_mtx_unlock(&purge_state.mtx);
+    return purge_state.pending_purge_lambda;
+}
 
-/* copy literals
- *
- * copy_literals.ptr = LitPtr
- * copy_literals.sz  = LitSz
- * ------ THR PROG COMMIT -----
- *
- *  - check process code
- *  - check process code
- *  ...
- * copy_literals.ptr = NULL
- * copy_literals.sz  = 0
- * ------ THR PROG COMMIT -----
- *  ...
- */
+static void
+finalize_purge_operation(Process *c_p, int succeded)
+{
+    Uint ix;
 
-#endif
+    if (c_p)
+	erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
 
-BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
-{
-#ifdef ERTS_NEW_PURGE_STRATEGY
-    BIF_ERROR(BIF_P, EXC_NOTSUP);
-#else
-    ErtsCodeIndex code_ix;
-    Eterm res = am_true;
+    erts_smp_mtx_lock(&purge_state.mtx);
 
-    if (BIF_P != erts_code_purger)
-	BIF_ERROR(BIF_P, EXC_NOTSUP);
+    ASSERT(purge_state.module != THE_NON_VALUE);
 
-    if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) {
-        BIF_ERROR(BIF_P, BADARG);
-    }
+    purge_state.module = THE_NON_VALUE;
 
-    if (!erts_try_seize_code_write_permission(BIF_P)) {
-	ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2],
-                        BIF_P, BIF_ARG_1, BIF_ARG_2);
+    /*
+     * Resume all processes that have tried to call
+     * funs in this code.
+     */
+    for (ix = 0; ix < purge_state.sp_ix; ix++) {
+	Process *rp = erts_pid2proc(NULL, 0,
+				    purge_state.sprocs[ix],
+				    ERTS_PROC_LOCK_STATUS);
+	if (rp) {
+	    erts_resume(rp, ERTS_PROC_LOCK_STATUS);
+	    erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+	}
     }
 
-    code_ix = erts_active_code_ix();
+    erts_smp_mtx_unlock(&purge_state.mtx);
 
-    if (BIF_ARG_2 == am_true) {
-        Module* modp = erts_get_module(BIF_ARG_1, code_ix);
-        if (!modp || !modp->old.code_hdr) {
-            res = am_false;
-            goto done;
-        }
-        if (erts_copy_literal_area) {
-            res = am_aborted;
-            goto done;
-        }
-	erts_copy_literal_area = modp->old.code_hdr->literal_area;
-    } else if (BIF_ARG_2 == am_false) {
-	erts_copy_literal_area = NULL;
+    if (c_p)
+	erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+    if (purge_state.sprocs != &purge_state.def_sprocs[0]) {
+	erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.sprocs);
+	purge_state.sprocs = &purge_state.def_sprocs[0];
+	purge_state.sp_size = sizeof(purge_state.def_sprocs);
+	purge_state.sp_size /= sizeof(purge_state.def_sprocs[0]);
     }
+    purge_state.sp_ix = 0;
 
-#ifdef ERTS_SMP
-    ASSERT(committer_state.stager == NULL);
-    committer_state.stager = BIF_P;
-    erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop);
-    erts_proc_inc_refc(BIF_P);
-    erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
-    ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
-#endif
-done:
-    erts_release_code_write_permission();
-    BIF_RET(res);
-#endif
+    if (purge_state.funs != &purge_state.def_funs[0]) {
+	erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.funs);
+	purge_state.funs = &purge_state.def_funs[0];
+	purge_state.fe_size = sizeof(purge_state.def_funs);
+	purge_state.fe_size /= sizeof(purge_state.def_funs[0]);
+    }
+    purge_state.fe_ix = 0;
 }
 
-#ifndef ERTS_NEW_PURGE_STRATEGY
-
 #ifdef ERTS_SMP
-static void copy_literals_commit(void* null) {
-    Process* p = committer_state.stager;
-#ifdef DEBUG
-    committer_state.stager = NULL;
-#endif
-    erts_release_code_write_permission();
+
+static ErtsThrPrgrLaterOp purger_lop_data;
+
+static void
+resume_purger(void *unused)
+{
+    Process *p = erts_code_purger;
     erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
-    if (!ERTS_PROC_IS_EXITING(p)) {
-	erts_resume(p, ERTS_PROC_LOCK_STATUS);
-    }
+    erts_resume(p, ERTS_PROC_LOCK_STATUS);
     erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
-    erts_proc_dec_refc(p);
 }
-#endif /* ERTS_SMP */
 
-#endif
+static void
+finalize_purge_abort(void *unused)
+{
+    erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix);
 
-/* 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)
+    finalize_purge_operation(NULL, 0);
+
+    resume_purger(NULL);
+}
+
+#endif /* ERTS_SMP */
+
+BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
 {
-    ErtsCodeIndex code_ix;
-    BeamInstr* code;
-    BeamInstr* end;
-    Module* modp;
-    int is_blocking = 0;
-    Eterm ret;
-    ErtsLiteralArea *literals = NULL;
+    if (BIF_P != erts_code_purger)
+	BIF_ERROR(BIF_P, EXC_NOTSUP);
 
-    if (is_not_atom(BIF_ARG_1)) {
+    if (is_not_atom(BIF_ARG_1))
 	BIF_ERROR(BIF_P, BADARG);
-    }
 
-    if (!erts_try_seize_code_write_permission(BIF_P)) {
-	ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1],
-                        BIF_P, BIF_ARG_1);
-    }
+    switch (BIF_ARG_2) {
 
-    code_ix = erts_active_code_ix();
+    case am_prepare: {
+	/*
+	 * Prepare for purge by marking all fun
+	 * entries referring to the code to purge
+	 * with "pending purge" markers.
+	 */
+	ErtsCodeIndex code_ix;
+	Module* modp;
+	Eterm res;
 
-    /*
-     * Correct module?
-     */
+	if (is_value(purge_state.module))
+	    BIF_ERROR(BIF_P, BADARG);
 
-    if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
-        ERTS_BIF_PREP_RET(ret, am_false);
-    }
-    else {
-	erts_rwlock_old_code(code_ix);
+	code_ix = erts_active_code_ix();
 
 	/*
-	 * Any code to purge?
+	 * Correct module?
 	 */
-	if (!modp->old.code_hdr) {
-            ERTS_BIF_PREP_RET(ret, am_false);
-	}
+	modp = erts_get_module(BIF_ARG_1, code_ix);
+	if (!modp)
+	    res = am_false;
 	else {
 	    /*
-	     * Unload any NIF library
+	     * Any code to purge?
 	     */
-	    if (modp->old.nif != NULL) {
-		/* ToDo: Do unload nif without blocking */
-		erts_rwunlock_old_code(code_ix);
-		erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
-		erts_smp_thr_progress_block();
-		is_blocking = 1;
-		erts_rwlock_old_code(code_ix);
-		erts_unload_nif(modp->old.nif);
-		modp->old.nif = NULL;
+	    erts_rlock_old_code(code_ix);
+	    if (!modp->old.code_hdr)
+		res = am_false;
+	    else {
+		BeamInstr* code;
+		BeamInstr* end;
+		erts_smp_mtx_lock(&purge_state.mtx);
+		purge_state.module = BIF_ARG_1;
+		erts_smp_mtx_unlock(&purge_state.mtx);
+		res = am_true;
+		code = (BeamInstr*) modp->old.code_hdr;
+		end = (BeamInstr *)((char *)code + modp->old.code_length);
+		erts_fun_purge_prepare(code, end);
+#if !defined(ERTS_NEW_PURGE_STRATEGY)
+		ASSERT(!erts_copy_literal_area);
+		erts_copy_literal_area = modp->old.code_hdr->literal_area;
+#endif
 	    }
-
+	    erts_runlock_old_code(code_ix);
+	}
+	
+#ifndef ERTS_SMP
+	BIF_RET(res);
+#else
+	if (res != am_true)
+	    BIF_RET(res);
+	else {
 	    /*
-	     * Remove the old code.
+	     * We'll be resumed when all schedulers are guaranteed
+	     * to see the "pending purge" markers that we've made on
+	     * all fun entries of the code that we are about to purge.
+	     * Processes trying to call these funs will be suspended
+	     * before calling the funs. That is we are guaranteed not
+	     * to get any more direct references into the code while
+	     * checking for such references...
 	     */
-	    ASSERT(erts_total_code_size >= modp->old.code_length);
-	    erts_total_code_size -= modp->old.code_length;
-	    code = (BeamInstr*) modp->old.code_hdr;
-	    end = (BeamInstr *)((char *)code + modp->old.code_length);
-	    erts_cleanup_funs_on_purge(code, end);
-	    beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
-				code_ix);
-	    literals = modp->old.code_hdr->literal_area;
-	    modp->old.code_hdr->literal_area = NULL;
-	    erts_free(ERTS_ALC_T_CODE, (void *) code);
-	    modp->old.code_hdr = NULL;
-	    modp->old.code_length = 0;
-	    modp->old.catches = BEAM_CATCHES_NIL;
-	    erts_remove_from_ranges(code);
-	    ERTS_BIF_PREP_RET(ret, am_true);
+	    erts_schedule_thr_prgr_later_op(resume_purger,
+					    NULL,
+					    &purger_lop_data);
+	    erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+	    ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
 	}
-	erts_rwunlock_old_code(code_ix);
+#endif
     }
-    if (is_blocking) {
-	erts_smp_thr_progress_unblock();
-	erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+    case am_abort: {
+	/*
+	 * Soft purge that detected direct references into the code
+	 * we set out to purge. Abort the purge.
+	 */
+
+	if (purge_state.module != BIF_ARG_1)
+	    BIF_ERROR(BIF_P, BADARG);
+
+	erts_fun_purge_abort_prepare(purge_state.funs, purge_state.fe_ix);
+
+#if !defined(ERTS_NEW_PURGE_STRATEGY)
+	ASSERT(erts_copy_literal_area);
+	erts_copy_literal_area = NULL;
+#endif
+#ifndef ERTS_SMP
+	erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix);
+	finalize_purge_operation(BIF_P, 0);
+	BIF_RET(am_false);
+#else
+	/*
+	 * We need to restore the code addresses of the funs in
+	 * two stages in order to ensure that we do not get any
+	 * stale suspended processes due to the purge abort.
+	 * Restore address pointer (erts_fun_purge_abort_prepare);
+	 * wait for thread progress; clear pending purge address
+	 * pointer (erts_fun_purge_abort_finalize), and then
+	 * resume processes that got suspended
+	 * (finalize_purge_operation).
+	 */
+	erts_schedule_thr_prgr_later_op(finalize_purge_abort,
+					NULL,
+					&purger_lop_data);
+	erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+	ERTS_BIF_YIELD_RETURN(BIF_P, am_false);
+#endif
     }
-    erts_release_code_write_permission();
 
-#ifdef ERTS_NEW_PURGE_STRATEGY
+    case am_complete: {
+	ErtsCodeIndex code_ix;
+	BeamInstr* code;
+	Module* modp;
+	int is_blocking = 0;
+	Eterm ret;
+	ErtsLiteralArea *literals = NULL;
 
-    if (literals) {
-	ErtsLiteralAreaRef *ref;
-	ref = erts_alloc(ERTS_ALC_T_LITERAL_REF,
-			 sizeof(ErtsLiteralAreaRef));
-	ref->literal_area = literals;
-	ref->next = NULL;
-	erts_smp_mtx_lock(&release_literal_areas.mtx);
-	if (release_literal_areas.last) {
-	    release_literal_areas.last->next = ref;
-	    release_literal_areas.last = ref;
+
+	/*
+	 * We have no direct references into the code.
+	 * Complete to purge.
+	 */
+
+	if (purge_state.module != BIF_ARG_1)
+	    BIF_ERROR(BIF_P, BADARG);
+
+	if (!erts_try_seize_code_write_permission(BIF_P)) {
+	    ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_purge_module_2],
+			    BIF_P, BIF_ARG_1, BIF_ARG_2);
+	}
+
+	code_ix = erts_active_code_ix();
+
+	/*
+	 * Correct module?
+	 */
+
+	if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
+	    ERTS_BIF_PREP_RET(ret, am_false);
 	}
 	else {
-	    release_literal_areas.first = ref;
-	    release_literal_areas.last = ref;
+
+	    erts_rwlock_old_code(code_ix);
+
+	    /*
+	     * Any code to purge?
+	     */
+	    if (!modp->old.code_hdr) {
+		ERTS_BIF_PREP_RET(ret, am_false);
+	    }
+	    else {
+		/*
+		 * Unload any NIF library
+		 */
+		if (modp->old.nif != NULL) {
+		    /* ToDo: Do unload nif without blocking */
+		    erts_rwunlock_old_code(code_ix);
+		    erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+		    erts_smp_thr_progress_block();
+		    is_blocking = 1;
+		    erts_rwlock_old_code(code_ix);
+		    erts_unload_nif(modp->old.nif);
+		    modp->old.nif = NULL;
+		}
+
+		/*
+		 * Remove the old code.
+		 */
+		ASSERT(erts_total_code_size >= modp->old.code_length);
+		erts_total_code_size -= modp->old.code_length;
+		code = (BeamInstr*) modp->old.code_hdr;
+		erts_fun_purge_complete(purge_state.funs, purge_state.fe_ix);
+		beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
+				    code_ix);
+		literals = modp->old.code_hdr->literal_area;
+		modp->old.code_hdr->literal_area = NULL;
+		erts_free(ERTS_ALC_T_CODE, (void *) code);
+		modp->old.code_hdr = NULL;
+		modp->old.code_length = 0;
+		modp->old.catches = BEAM_CATCHES_NIL;
+		erts_remove_from_ranges(code);
+		ERTS_BIF_PREP_RET(ret, am_true);
+	    }
+	    erts_rwunlock_old_code(code_ix);
 	}
-	erts_smp_mtx_unlock(&release_literal_areas.mtx);
-	erts_queue_message(erts_literal_area_collector,
-			   0,
-			   erts_alloc_message(0, NULL),
-			   am_copy_literals,
-			   BIF_P->common.id);
-    }
+	if (is_blocking) {
+	    erts_smp_thr_progress_unblock();
+	    erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+	}
+
+	erts_release_code_write_permission();
 
-#else /* !ERTS_NEW_PURGE_STRATEGY */
+	finalize_purge_operation(BIF_P, ret == am_true);
 
-    erts_release_literal_area(literals);
+#if !defined(ERTS_NEW_PURGE_STRATEGY)
 
-#endif
+	ASSERT(erts_copy_literal_area == literals);
+	erts_copy_literal_area = NULL;
+	erts_release_literal_area(literals);
+
+#else /* ERTS_NEW_PURGE_STRATEGY */
+
+	if (literals) {
+	    ErtsLiteralAreaRef *ref;
+	    ref = erts_alloc(ERTS_ALC_T_LITERAL_REF,
+			     sizeof(ErtsLiteralAreaRef));
+	    ref->literal_area = literals;
+	    ref->next = NULL;
+	    erts_smp_mtx_lock(&release_literal_areas.mtx);
+	    if (release_literal_areas.last) {
+		release_literal_areas.last->next = ref;
+		release_literal_areas.last = ref;
+	    }
+	    else {
+		release_literal_areas.first = ref;
+		release_literal_areas.last = ref;
+	    }
+	    erts_smp_mtx_unlock(&release_literal_areas.mtx);
+	    erts_queue_message(erts_literal_area_collector,
+			       0,
+			       erts_alloc_message(0, NULL),
+			       am_copy_literals,
+			       BIF_P->common.id);
+	}
 
-    return ret;
+#endif /* ERTS_NEW_PURGE_STRATEGY */
+
+	return ret;
+    }
+
+    default:
+	BIF_ERROR(BIF_P, BADARG);
+
+    }
 }
 
 /*
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index c6258287c4..bc7c9165fd 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -6535,34 +6535,49 @@ call_fun(Process* p,		/* Current process. */
 		 * representation (the module has never been loaded),
 		 * or the module defining the fun has been unloaded.
 		 */
+
 		module = fe->module;
-		if ((modp = erts_get_module(module, code_ix)) != NULL
-		    && modp->curr.code_hdr != NULL) {
+
+		ERTS_SMP_READ_MEMORY_BARRIER;
+		if (fe->pend_purge_address) {
 		    /*
-		     * There is a module loaded, but obviously the fun is not
-		     * defined in it. We must not call the error_handler
-		     * (or we will get into an infinite loop).
+		     * The system is currently trying to purge the
+		     * module containing this fun. Suspend the process
+		     * and let it try again when the purge operation is
+		     * done (may succeed or not).
 		     */
-		    goto badfun;
+		    ep = erts_suspend_process_on_pending_purge_lambda(p);
+		    ASSERT(ep);
 		}
+		else {
+		    if ((modp = erts_get_module(module, code_ix)) != NULL
+			&& modp->curr.code_hdr != NULL) {
+			/*
+			 * There is a module loaded, but obviously the fun is not
+			 * defined in it. We must not call the error_handler
+			 * (or we will get into an infinite loop).
+			 */
+			goto badfun;
+		    }
 		
-		/*
-		 * No current code for this module. Call the error_handler module
-		 * to attempt loading the module.
-		 */
+		    /*
+		     * No current code for this module. Call the error_handler module
+		     * to attempt loading the module.
+		     */
 
-		ep = erts_find_function(erts_proc_get_error_handler(p),
-					am_undefined_lambda, 3, code_ix);
-		if (ep == NULL) {	/* No error handler */
-		    p->current = NULL;
-		    p->freason = EXC_UNDEF;
-		    return NULL;
+		    ep = erts_find_function(erts_proc_get_error_handler(p),
+					    am_undefined_lambda, 3, code_ix);
+		    if (ep == NULL) {	/* No error handler */
+			p->current = NULL;
+			p->freason = EXC_UNDEF;
+			return NULL;
+		    }
 		}
 		reg[0] = module;
 		reg[1] = fun;
 		reg[2] = args;
 		reg[3] = NIL;
-		return ep->addressv[erts_active_code_ix()];
+		return ep->addressv[code_ix];
 	    }
 	}
     } else if (is_export_header(hdr)) {
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index d52f12e6d0..1200bb9c6f 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -121,8 +121,10 @@ typedef struct beam_code_header {
 
 void erts_release_literal_area(struct ErtsLiteralArea_* literal_area);
 int erts_is_module_native(BeamCodeHeader* code);
-
 void erts_beam_bif_load_init(void);
+struct erl_fun_entry;
+void erts_purge_state_add_fun(struct erl_fun_entry *fe);
+Export *erts_suspend_process_on_pending_purge_lambda(Process *c_p);
 
 /*
  * Layout of the line table.
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 7ffcb26567..90ac5e9ed8 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -644,8 +644,7 @@ bif erts_debug:map_info/1
 # New in 19.0
 #
 
-bif erts_internal:copy_literals/2
-bif erts_internal:purge_module/1
+bif erts_internal:purge_module/2
 bif binary:split/2
 bif binary:split/3
 bif erts_debug:size_shared/1
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 0a4a34a174..1b72a0cb59 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -368,6 +368,7 @@ type	NLINK_LH	STANDARD	PROCESSES	nlink_lh
 type	CODE		LONG_LIVED	CODE		code
 type	LITERAL		LITERAL 	CODE		literal
 type	LITERAL_REF	SHORT_LIVED	CODE		literal_area_ref
+type	PURGE_DATA	SHORT_LIVED	CODE		purge_data
 type	DB_HEIR_DATA	STANDARD	ETS		db_heir_data
 type	DB_MS_PSDO_PROC	LONG_LIVED	ETS		db_match_pseudo_proc
 type	SCHDLR_DATA	LONG_LIVED	SYSTEM		scheduler_data
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 3fb866733c..ef3fa07664 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -2886,6 +2886,27 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
 	BIF_RET(AM_tag);
 #endif
     }
+    else if (ERTS_IS_ATOM_STR("check_process_code",BIF_ARG_1)) {
+	Eterm terms[3];
+	Sint length = 1;
+	Uint sz = 0;
+	Eterm *hp, res;
+	DECL_AM(direct_references);
+
+	terms[0] = AM_direct_references;
+#if !defined(ERTS_NEW_PURGE_STRATEGY)
+	{
+	    DECL_AM(indirect_references);
+	    terms[1] = AM_indirect_references;
+	    terms[2] = am_copy_literals;
+	    length = 3;
+	}
+#endif
+	erts_bld_list(NULL, &sz, length, terms);
+	hp = HAlloc(BIF_P, sz);
+	res = erts_bld_list(&hp, NULL, length, terms);
+	BIF_RET(res);
+    }
 
     BIF_ERROR(BIF_P, BADARG);
 }
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index 6ce1376c81..c639ba623f 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -199,14 +199,13 @@ erts_erase_fun_entry(ErlFunEntry* fe)
 }
 
 void
-erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end)
+erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end)
 {
     int limit;
     HashBucket** bucket;
-    ErlFunEntry* to_delete = NULL;
     int i;
 
-    erts_fun_write_lock();
+    erts_fun_read_lock();
     limit = erts_fun_table.size;
     bucket = erts_fun_table.bucket;
     for (i = 0; i < limit; i++) {
@@ -217,22 +216,51 @@ erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end)
 	    BeamInstr* addr = fe->address;
 
 	    if (start <= addr && addr < end) {
+		fe->pend_purge_address = addr;
+		ERTS_SMP_WRITE_MEMORY_BARRIER;
 		fe->address = unloaded_fun;
-		if (erts_refc_dectest(&fe->refc, 0) == 0) {
-		    fe->address = (void *) to_delete;
-		    to_delete = fe;
-		}
+		erts_purge_state_add_fun(fe);
 	    }
 	    b = b->next;
 	}
     }
+    erts_fun_read_unlock();
+}
+
+void
+erts_fun_purge_abort_prepare(ErlFunEntry **funs, Uint no)
+{
+    Uint ix;
 
-    while (to_delete != NULL) {
-	ErlFunEntry* next = (ErlFunEntry *) to_delete->address;
-	erts_erase_fun_entry_unlocked(to_delete);
-	to_delete = next;
+    for (ix = 0; ix < no; ix++) {
+	ErlFunEntry *fe = funs[ix];
+	if (fe->address == unloaded_fun)
+	    fe->address = fe->pend_purge_address;
+	fe->pend_purge_address = NULL;
     }
-    erts_fun_write_unlock();
+}
+
+void
+erts_fun_purge_abort_finalize(ErlFunEntry **funs, Uint no)
+{
+    Uint ix;
+
+    for (ix = 0; ix < no; ix++)
+	funs[ix]->pend_purge_address = NULL;
+}
+
+void
+erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
+{
+    Uint ix;
+
+    for (ix = 0; ix < no; ix++) {
+	ErlFunEntry *fe = funs[ix];
+	fe->pend_purge_address = NULL;
+	if (erts_refc_dectest(&fe->refc, 0) == 0)
+	    erts_erase_fun_entry(fe);
+    }
+    ERTS_SMP_WRITE_MEMORY_BARRIER;
 }
 
 void
@@ -294,6 +322,7 @@ fun_alloc(ErlFunEntry* template)
     obj->module = template->module;
     erts_refc_init(&obj->refc, -1);
     obj->address = unloaded_fun;
+    obj->pend_purge_address = NULL;
 #ifdef HIPE
     obj->native_address = NULL;
 #endif
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index 8c4deea7a0..73c3e19c1c 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -44,6 +44,7 @@ typedef struct erl_fun_entry {
     Eterm module;		/* Tagged atom for module. */
     erts_refc_t refc;		/* Reference count: One for code + one for each
 				   fun object in each process. */
+    BeamInstr *pend_purge_address; /* address stored during a pending purge */
 } ErlFunEntry;
 
 /*
@@ -81,7 +82,10 @@ ErlFunEntry* erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
 
 void erts_erase_fun_entry(ErlFunEntry* fe);
 void erts_cleanup_funs(ErlFunThing* funp);
-void erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end);
+void erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end);
+void erts_fun_purge_abort_prepare(ErlFunEntry **funs, Uint no);
+void erts_fun_purge_abort_finalize(ErlFunEntry **funs, Uint no);
+void erts_fun_purge_complete(ErlFunEntry **funs, Uint no);
 void erts_dump_fun_entries(int, void *);
 
 #endif
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 788dbc3328..a1b0a398da 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -2260,14 +2260,19 @@ erl_start(int argc, char **argv)
 	Eterm pid;
 
 	pid = erl_system_process_otp(otp_ring0_pid, "erts_code_purger");
-	erts_code_purger = erts_proc_lookup(pid);
-	ASSERT(erts_code_purger);
+	erts_code_purger
+	    = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+						    internal_pid_index(pid));
+	ASSERT(erts_code_purger && erts_code_purger->common.id == pid);
 	erts_proc_inc_refc(erts_code_purger); 
 
 #ifdef ERTS_NEW_PURGE_STRATEGY
 	pid = erl_system_process_otp(otp_ring0_pid, "erts_literal_area_collector");
-	erts_literal_area_collector = erts_proc_lookup(pid);
-	ASSERT(erts_literal_area_collector);
+	erts_literal_area_collector
+	    = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+						    internal_pid_index(pid));
+	ASSERT(erts_literal_area_collector
+	       && erts_literal_area_collector->common.id == pid);
 	erts_proc_inc_refc(erts_literal_area_collector);
 #endif
 
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 4192cf389f..06266363b5 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -96,6 +96,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
     {	"dist_entry",				"address"		},
     {	"dist_entry_links",			"address"		},
     {   "code_write_permission",                NULL                    },
+    {	"purge_state",		      		NULL			},
     {	"proc_status",				"pid"			},
     {	"proc_trace",				"pid"			},
     {   "ports_snapshot",                       NULL                    },