From aeb645a709b73e1bda0281f87dda2af3ce92dfe7 Mon Sep 17 00:00:00 2001
From: Rickard Green <rickard@erlang.org>
Date: Wed, 20 Jul 2016 17:30:39 +0200
Subject: Separate literal area from code

---
 erts/emulator/beam/beam_bif_load.c | 33 ++++++--------------------
 erts/emulator/beam/beam_load.c     | 47 +++++++++++++++++++++++++++++---------
 erts/emulator/beam/beam_load.h     | 14 +++++++++---
 3 files changed, 54 insertions(+), 40 deletions(-)

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 15e878ba65..a94a3cc3d3 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -40,7 +40,6 @@
 static void set_default_trace_pattern(Eterm module);
 static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls);
 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);
 static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 
@@ -861,8 +860,8 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
     ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
     erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
 
-    literals = (char*) modp->old.code_hdr->literals_start;
-    lit_bsize = (char*) modp->old.code_hdr->literals_end - literals;
+    literals = (char*) modp->old.code_hdr->literal_area->start;
+    lit_bsize = (char*) modp->old.code_hdr->literal_area->end - literals;
 
     for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
 	if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
@@ -994,7 +993,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 	}
 	if (need_gc & ERTS_LITERAL_GC__) {
 	    struct erl_off_heap_header* oh;
-	    oh = modp->old.code_hdr->literals_off_heap;
+	    oh = modp->old.code_hdr->literal_area->off_heap;
 	    *redsp += lit_bsize / 64; /* Need, better value... */
 	    erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
 	    done_gc |= ERTS_LITERAL_GC__;
@@ -1186,8 +1185,8 @@ BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
             res = am_aborted;
             goto done;
         }
-        erts_clrange.ptr = modp->old.code_hdr->literals_start;
-        erts_clrange.sz  = modp->old.code_hdr->literals_end - erts_clrange.ptr;
+        erts_clrange.ptr = modp->old.code_hdr->literal_area->start;
+        erts_clrange.sz  = modp->old.code_hdr->literal_area->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) {
@@ -1295,10 +1294,8 @@ BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
 	    erts_cleanup_funs_on_purge(code, end);
 	    beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
 				code_ix);
-	    decrement_refc(modp->old.code_hdr);
-            if (modp->old.code_hdr->literals_start) {
-                erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start);
-            }
+	    erts_release_literal_area(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;
@@ -1316,22 +1313,6 @@ BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
     return ret;
 }
 
-static void
-decrement_refc(BeamCodeHeader* code_hdr)
-{
-    struct erl_off_heap_header* oh = code_hdr->literals_off_heap;
-
-    while (oh) {
-	Binary* bptr;
-	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
-	bptr = ((ProcBin*)oh)->val;
-	if (erts_refc_dectest(&bptr->refc, 0) == 0) {
-	    erts_bin_free(bptr);
-	}
-	oh = oh->next;
-    }
-}
-
 /*
  * Move code from current to old and null all export entries for the module
  */
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 0c2743beb2..b2c4fe5f5e 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -663,7 +663,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
     stp->hdr->compile_ptr = NULL;
     stp->hdr->compile_size = 0;
     stp->hdr->compile_size_on_heap = 0;
-    stp->hdr->literals_start = NULL;
+    stp->hdr->literal_area = NULL;
     stp->hdr->md5_ptr = NULL;
 
     /*
@@ -1005,8 +1005,9 @@ loader_state_dtor(Binary* magic)
 	stp->bin = 0;
     }
     if (stp->hdr != 0) {
-        if (stp->hdr->literals_start) {
-            erts_free(ERTS_ALC_T_LITERAL, stp->hdr->literals_start);
+        if (stp->hdr->literal_area) {
+	    erts_release_literal_area(stp->hdr->literal_area);
+	    stp->hdr->literal_area = NULL;
         }
 	erts_free(ERTS_ALC_T_CODE, stp->hdr);
 	stp->hdr = 0;
@@ -4560,13 +4561,16 @@ freeze_code(LoaderState* stp)
 	Eterm* ptr;
 	LiteralPatch* lp;
         ErlOffHeap code_off_heap;
+	ErtsLiteralArea *literal_area;
+	Uint lit_asize;
 
         ERTS_INIT_OFF_HEAP(&code_off_heap);
 
-        ptr = (Eterm*)erts_alloc(ERTS_ALC_T_LITERAL,
-                                 stp->total_literal_size*sizeof(Eterm));
-	code_hdr->literals_start = ptr;
-	code_hdr->literals_end = ptr + stp->total_literal_size;
+	lit_asize = ERTS_LITERAL_AREA_ALLOC_SIZE(stp->total_literal_size);
+	literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_asize);
+	ptr = &literal_area->start[0];
+	literal_area->end = ptr + stp->total_literal_size;
+
 	for (i = 0; i < stp->num_literals; i++) {
             if (is_not_immed(stp->literals[i].term)) {
                 erts_move_multi_frags(&ptr, &code_off_heap,
@@ -4576,7 +4580,7 @@ freeze_code(LoaderState* stp)
 				       ptr_val(stp->literals[i].term)));
             }
 	}
-	code_hdr->literals_off_heap = code_off_heap.first;
+	literal_area->off_heap = code_off_heap.first;
 	lp = stp->literal_patches;
 	while (lp != 0) {
 	    BeamInstr* op_ptr;
@@ -4587,6 +4591,7 @@ freeze_code(LoaderState* stp)
 	    op_ptr[0] = lit->term;
 	    lp = lp->next;
 	}
+	code_hdr->literal_area = literal_area;
     }
     CHKBLK(ERTS_ALC_T_CODE,code);
 
@@ -5642,6 +5647,28 @@ has_native(BeamCodeHeader *code_hdr)
     return result;
 }
 
+void
+erts_release_literal_area(ErtsLiteralArea* literal_area)
+{
+    struct erl_off_heap_header* oh;
+
+    if (!literal_area)
+	return;
+
+    oh = literal_area->off_heap;
+	
+    while (oh) {
+	Binary* bptr;
+	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
+	bptr = ((ProcBin*)oh)->val;
+	if (erts_refc_dectest(&bptr->refc, 0) == 0) {
+	    erts_bin_free(bptr);
+	}
+	oh = oh->next;
+    }
+    erts_free(ERTS_ALC_T_LITERAL, literal_area);
+}
+
 int
 erts_is_module_native(BeamCodeHeader* code_hdr)
 {
@@ -6373,9 +6400,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     code_hdr->compile_ptr = NULL;
     code_hdr->compile_size = 0;
     code_hdr->compile_size_on_heap = 0;
-    code_hdr->literals_start = NULL;
-    code_hdr->literals_end = NULL;
-    code_hdr->literals_off_heap = 0;
+    code_hdr->literal_area = NULL;
     code_hdr->on_load_function_ptr = NULL;
     code_hdr->line_table = NULL;
     code_hdr->md5_ptr = NULL;
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index fd2dd97fee..336f097f0f 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -60,6 +60,15 @@ extern BeamInstr* em_call_nif;
 /* Total code size in bytes */
 extern Uint erts_total_code_size;
 
+typedef struct {
+    struct erl_off_heap_header *off_heap;
+    Eterm *end;
+    Eterm start[1]; /* beginning of area */
+} ErtsLiteralArea;
+
+#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
+    (sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
+
 typedef struct BeamCodeLineTab_ BeamCodeLineTab;
 
 /*
@@ -89,9 +98,7 @@ typedef struct beam_code_header {
     /*
      * Literal area (constant pool).
      */
-    Eterm* literals_start;
-    Eterm* literals_end;
-    struct erl_off_heap_header* literals_off_heap;
+    ErtsLiteralArea *literal_area;
 
     /*
      * Pointer to the on_load function (or NULL if none).
@@ -120,6 +127,7 @@ typedef struct beam_code_header {
 
 }BeamCodeHeader;
 
+void erts_release_literal_area(ErtsLiteralArea* literal_area);
 int erts_is_module_native(BeamCodeHeader* code);
 
 /*
-- 
cgit v1.2.3


From 2fe03e832adb11c50bcfc62679cf17779b284124 Mon Sep 17 00:00:00 2001
From: Rickard Green <rickard@erlang.org>
Date: Wed, 27 Jul 2016 19:45:41 +0200
Subject: Reclaim literal area after purge has completed

---
 erts/configure.in                                  |  29 ++
 erts/emulator/Makefile.in                          |  30 +-
 erts/emulator/beam/atom.names                      |   2 +
 erts/emulator/beam/beam_bif_load.c                 | 478 ++++++++++++++++++++-
 erts/emulator/beam/beam_load.h                     |  16 +-
 erts/emulator/beam/bif.tab                         |   2 +
 erts/emulator/beam/erl_alloc.types                 |   1 +
 erts/emulator/beam/erl_init.c                      |  28 +-
 erts/emulator/beam/erl_lock_check.c                |   3 +
 erts/emulator/beam/erl_process.c                   |  44 +-
 erts/emulator/beam/global.h                        |  37 +-
 erts/preloaded/ebin/erts_code_purger.beam          | Bin 8696 -> 9904 bytes
 erts/preloaded/ebin/erts_internal.beam             | Bin 10536 -> 10576 bytes
 .../ebin/erts_literal_area_collector.beam          | Bin 0 -> 3304 bytes
 erts/preloaded/src/Makefile                        |   3 +-
 erts/preloaded/src/erts.app.src                    |   2 +-
 erts/preloaded/src/erts_code_purger.erl            |  49 ++-
 erts/preloaded/src/erts_internal.erl               |  11 +-
 erts/preloaded/src/erts_literal_area_collector.erl | 113 +++++
 lib/kernel/test/init_SUITE.erl                     |  48 ++-
 lib/sasl/src/sasl.app.src                          |   2 +-
 lib/sasl/src/systools_make.erl                     |   3 +-
 22 files changed, 816 insertions(+), 85 deletions(-)
 create mode 100644 erts/preloaded/ebin/erts_literal_area_collector.beam
 create mode 100644 erts/preloaded/src/erts_literal_area_collector.erl

diff --git a/erts/configure.in b/erts/configure.in
index 81ecad4f51..cdd144be9d 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -121,6 +121,7 @@ AS_HELP_STRING([--enable-bootstrap-only],
 	enable_hipe=no
 	enable_sctp=no
         enable_dirty_schedulers=no
+        enable_new_purge=no
   fi	
 ])
 
@@ -139,6 +140,13 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]),
     *)  enable_dirty_schedulers=yes ;;
   esac ], enable_dirty_schedulers=default)
 
+AC_ARG_ENABLE(new-purge-strategy,
+AS_HELP_STRING([--enable-new-purge-strategy], [enable new code purge strategy]),
+[ case "$enableval" in
+    no) enable_new_purge=no ;;
+    *)  enable_new_purge=yes ;;
+  esac ], enable_new_purge=default)
+
 AC_ARG_ENABLE(smp-support,
 AS_HELP_STRING([--enable-smp-support], [enable smp support])
 AS_HELP_STRING([--disable-smp-support], [disable smp support]),
@@ -1023,6 +1031,27 @@ esac
 AC_MSG_RESULT($DIRTY_SCHEDULER_SUPPORT)
 AC_SUBST(DIRTY_SCHEDULER_SUPPORT)
 
+AC_MSG_CHECKING(whether the new code purge strategy should be enabled)
+case $enable_new_purge-$enable_dirty_schedulers in
+     yes-*)
+	AC_MSG_RESULT(yes)
+	enable_new_purge=yes;;
+     default-yes)
+	AC_MSG_RESULT(yes; forced by dirty scheduler support)
+	enable_new_purge=yes;;
+     no-yes)
+	AC_MSG_ERROR([Dirty schedulers enabled, but new code purge strategy disabled]);;
+     *)
+	AC_MSG_RESULT(no)
+	enable_new_purge=no;;
+esac
+
+if test $enable_new_purge = yes; then
+   AC_DEFINE(ERTS_NEW_PURGE_STRATEGY, 1, [Define if you want to use the new code purge strategy])
+fi
+NEW_PURGE_STRATEGY=$enable_new_purge
+AC_SUBST(NEW_PURGE_STRATEGY)
+
 if test $ERTS_BUILD_SMP_EMU = yes; then
 
 	if test $found_threads = no; then
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 2212aed5e0..e3e0e70476 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -51,6 +51,7 @@ ARFLAGS=rc
 OMIT_OMIT_FP=no
 
 DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@
+NEW_PURGE_STRATEGY=@NEW_PURGE_STRATEGY@
 
 ifeq ($(TYPE),debug)
 PURIFY =
@@ -591,11 +592,8 @@ GENERATE += $(TTF_DIR)/driver_tab.c
 # 
 # This list must be consistent with PRE_LOADED_MODULES in
 # erts/preloaded/src/Makefile.
-ifeq ($(TARGET),win32)
-# On windows the preloaded objects are in a resource object.
-PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
-PRELOAD_SRC = $(TARGET)/beams.rc
-$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+
+PRELOAD_BEAM =		$(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 \
@@ -606,23 +604,19 @@ $(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 \
-			$(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam
+			$(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam \
+			$(ERL_TOP)/erts/preloaded/ebin/erts_literal_area_collector.beam
+
+ifeq ($(TARGET),win32)
+# On windows the preloaded objects are in a resource object.
+PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
+PRELOAD_SRC = $(TARGET)/beams.rc
+$(PRELOAD_SRC): $(PRELOAD_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 \
-			$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
-			$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
-			$(ERL_TOP)/erts/preloaded/ebin/prim_zip.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 \
-			$(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam
+$(PRELOAD_SRC): $(PRELOAD_BEAM)
 	$(gen_verbose)LANG=C $(PERL) utils/make_preload -old $^ > $@
 endif
 
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index badd69856e..dd37c682b1 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -176,6 +176,7 @@ atom const
 atom context_switches
 atom control
 atom copy
+atom copy_literals
 atom counters
 atom cpu
 atom cpu_timestamp
@@ -407,6 +408,7 @@ atom named_table
 atom namelist
 atom native
 atom native_addresses
+atom need_gc
 atom Neq='=/='
 atom Neqeq='/='
 atom net_kernel
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index a94a3cc3d3..484198b339 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -37,12 +37,41 @@
 #include "erl_bits.h"
 #include "erl_thr_progress.h"
 
+Process *erts_code_purger = NULL;
+
+ErtsLiteralArea *erts_copy_literal_area = NULL;
+#ifdef ERTS_NEW_PURGE_STRATEGY
+Process *erts_literal_area_collector = NULL;
+
+typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef;
+struct ErtsLiteralAreaRef_ {
+    ErtsLiteralAreaRef *next;
+    ErtsLiteralArea *literal_area;
+};
+
+struct {
+    erts_smp_mtx_t mtx;
+    ErtsLiteralAreaRef *first;
+    ErtsLiteralAreaRef *last;
+} release_literal_areas;
+#endif
+
 static void set_default_trace_pattern(Eterm module);
 static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls);
 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);
 
+void
+erts_beam_bif_load_init(void)
+{
+#ifdef ERTS_NEW_PURGE_STRATEGY
+    erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas");
+    release_literal_areas.first = NULL;
+    release_literal_areas.last = NULL;
+#endif
+}
+
 BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
 {
     Module* modp;
@@ -767,6 +796,311 @@ static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
                                Eterm *start, Eterm *end,
                                char *lit_start, Uint lit_size);
 
+#ifdef ERTS_NEW_PURGE_STRATEGY
+
+Eterm
+erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed)
+{
+    ErtsLiteralArea *la;
+    ErtsMessage *msgp;
+    struct erl_off_heap_header* oh;
+    char *literals;
+    Uint lit_bsize;
+    ErlHeapFragment *hfrag;
+
+    la = erts_copy_literal_area;
+    if (!la)
+	return am_ok;
+
+    oh = la->off_heap;
+    literals = (char *) &la->start[0];
+    lit_bsize = (char *) la->end - literals;
+
+    /*
+     * If a literal is in the message queue we make an explicit copy of
+     * it and attach it to the heap fragment. Each message needs to be
+     * self contained, we cannot save the literal in the old_heap or
+     * any other heap than the message it self.
+     */
+
+    erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+    ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+    erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+    for (msgp = c_p->msg.first; msgp; msgp = msgp->next) {
+	ErlHeapFragment *hf;
+	Uint lit_sz = 0;
+
+	*redsp += 1;
+
+	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; /* Content on heap or in external term format... */
+
+	for (hf = hfrag; hf; hf = hf->next) {
+	    lit_sz += hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size],
+					literals, lit_bsize);
+	    *redsp += 1;
+	}
+
+	*redsp += lit_sz / 16; /* Better value needed... */
+	if (lit_sz > 0) {
+	    ErlHeapFragment *bp = new_message_buffer(lit_sz);
+	    Eterm *hp = bp->mem;
+
+	    for (hf = hfrag; hf; hf = hf->next) {
+		hfrag_literal_copy(&hp, &bp->off_heap,
+				   &hf->mem[0], &hf->mem[hf->used_size],
+				   literals, lit_bsize);
+		hfrag = hf;
+	    }
+
+	    /* link new hfrag last */
+	    ASSERT(hfrag->next == NULL);
+	    hfrag->next = bp;
+	    bp->next = NULL;
+        }
+    }
+
+    if (gc_allowed) {
+	/*
+	 * Current implementation first tests without
+	 * allowing GC, and then restarts the operation
+	 * allowing GC if it is needed. It is therfore
+	 * very likely that we will need the GC (although
+	 * this is not completely certain). We go for
+	 * the GC directly instead of scanning everything
+	 * one more time...
+	 */
+	goto literal_gc;
+    }
+
+    *redsp += 2;
+    if (any_heap_ref_ptrs(&c_p->fvalue, &c_p->fvalue+1, literals, lit_bsize)) {
+	c_p->freason = EXC_NULL;
+	c_p->fvalue = NIL;
+	c_p->ftrace = NIL;
+    }
+
+    if (any_heap_ref_ptrs(c_p->stop, c_p->hend, literals, lit_bsize))
+	goto literal_gc;
+    *redsp += 1;
+    if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize))
+	goto literal_gc;
+    *redsp += 1;
+    if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize))
+	goto literal_gc;
+
+    /* Check dictionary */
+    *redsp += 1;
+    if (c_p->dictionary) {
+	Eterm* start = ERTS_PD_START(c_p->dictionary);
+	Eterm* end = start + ERTS_PD_SIZE(c_p->dictionary);
+
+	if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
+	    goto literal_gc;
+    }
+
+    /* Check heap fragments */
+    for (hfrag = c_p->mbuf; hfrag; hfrag = hfrag->next) {
+	Eterm *hp, *hp_end;
+
+	*redsp += 1;
+
+	hp = &hfrag->mem[0];
+	hp_end = &hfrag->mem[hfrag->used_size];
+	if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+	    goto literal_gc;
+    }
+
+    /*
+     * Message buffer fragments (matched messages) 
+     *  - off heap lists should already have been moved into
+     *    process off heap structure.
+     *  - Check for literals
+     */
+    for (msgp = c_p->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(c_p, &hfrag->off_heap, mod_start, mod_size));
+
+	    *redsp += 1;
+
+	    hp = &hfrag->mem[0];
+	    hp_end = &hfrag->mem[hfrag->used_size];
+
+	    if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+		goto literal_gc;
+	}
+    }
+
+    return am_ok;
+
+literal_gc:
+
+    if (!gc_allowed)
+	return am_need_gc;
+
+    if (c_p->flags & F_DISABLE_GC)
+	return THE_NON_VALUE;
+
+    FLAGS(c_p) |= F_NEED_FULLSWEEP;
+
+    *redsp += erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls);
+
+    erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, oh);
+
+    *redsp += lit_bsize / 64; /* Need, better value... */
+
+    return am_ok;
+}
+
+static Eterm
+check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls)
+{
+    BeamInstr* start;
+    char* mod_start;
+    Uint mod_size;
+    Eterm* sp;
+    int done_gc = 0;
+    ErtsMessage *msgp;
+    ErlHeapFragment *hfrag;
+
+    /*
+     * Pick up limits for the module.
+     */
+    start = (BeamInstr*) modp->old.code_hdr;
+    mod_start = (char *) start;
+    mod_size = modp->old.code_length;
+
+    /*
+     * Check if current instruction or continuation pointer points into module.
+     */
+    if (ErtsInArea(rp->i, mod_start, mod_size)
+	|| ErtsInArea(rp->cp, mod_start, mod_size)) {
+	return am_true;
+    }
+
+    /*
+     * Check all continuation pointers stored on the stack.
+     */
+    for (sp = rp->stop; sp < STACK_START(rp); sp++) {
+	if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) {
+	    return am_true;
+	}
+    }
+
+    /* 
+     * Check all continuation pointers stored in stackdump
+     * and clear exception stackdump if there is a pointer
+     * to the module.
+     */
+    if (rp->ftrace != NIL) {
+	struct StackTrace *s;
+	ASSERT(is_list(rp->ftrace));
+	s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
+	if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) ||
+	    (s->current && ErtsInArea(s->current, mod_start, mod_size))) {
+	    rp->freason = EXC_NULL;
+	    rp->fvalue = NIL;
+	    rp->ftrace = NIL;
+	} else {
+	    int i;
+	    for (i = 0;  i < s->depth;  i++) {
+		if (ErtsInArea(s->trace[i], mod_start, mod_size)) {
+		    rp->freason = EXC_NULL;
+		    rp->fvalue = NIL;
+		    rp->ftrace = NIL;
+		    break;
+		}
+	    }
+	}
+    }
+
+    /*
+     * 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;
+    }
+
+}
+
+#else /* !ERTS_NEW_PURGE_STRATEGY, i.e, old style purge... */
+
 static Eterm
 check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls)
 {
@@ -860,8 +1194,14 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
     ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
     erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
 
-    literals = (char*) modp->old.code_hdr->literal_area->start;
-    lit_bsize = (char*) modp->old.code_hdr->literal_area->end - literals;
+    if (modp->old.code_hdr->literal_area) {
+	literals = (char*) modp->old.code_hdr->literal_area->start;
+	lit_bsize = (char*) modp->old.code_hdr->literal_area->end - literals;
+    }
+    else {
+	literals = NULL;
+	lit_bsize = 0;
+    }
 
     for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
 	if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
@@ -902,12 +1242,6 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 	/* 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;
@@ -1006,6 +1340,8 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 
 }
 
+#endif /*  !ERTS_NEW_PURGE_STRATEGY */
+
 static int
 any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
 {
@@ -1136,12 +1472,73 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
 
 #undef in_area
 
+#ifdef ERTS_NEW_PURGE_STRATEGY
+
+ErtsThrPrgrLaterOp later_literal_area_switch;
+
+static void
+complete_literal_area_switch(void *unused)
+{
+    Process *p = erts_literal_area_collector;
+    erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+    erts_resume(p, ERTS_PROC_LOCK_STATUS);
+    erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+}
+
+#endif /* ERTS_NEW_PURGE_STRATEGY */
+
+BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
+{
+#ifndef ERTS_NEW_PURGE_STRATEGY
+    BIF_ERROR(BIF_P, EXC_NOTSUP);
+#else
+    ErtsLiteralAreaRef *la_ref;
+
+    if (BIF_P != erts_literal_area_collector)
+	BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+    erts_smp_mtx_lock(&release_literal_areas.mtx);
+
+    la_ref = release_literal_areas.first;
+    if (la_ref) {
+	release_literal_areas.first = la_ref->next;
+	if (!release_literal_areas.first)
+	    release_literal_areas.last = NULL;
+    }
+
+    erts_smp_mtx_unlock(&release_literal_areas.mtx);
+
+    if (erts_copy_literal_area)
+	erts_release_literal_area(erts_copy_literal_area);
+
+    if (!la_ref) {
+	erts_copy_literal_area = NULL;
+	BIF_RET(am_false);
+    }
+
+    erts_copy_literal_area = la_ref->literal_area;
+
+    erts_free(ERTS_ALC_T_LITERAL_REF, la_ref);
+
+#ifndef ERTS_SMP
+    BIF_RET(am_true);
+#else
+    erts_schedule_thr_prgr_later_op(complete_literal_area_switch,
+				    NULL,
+				    &later_literal_area_switch);
+    erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+    ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+#endif
+
+#endif /* ERTS_NEW_PURGE_STRATEGY */
+}
+
+#ifndef ERTS_NEW_PURGE_STRATEGY
+
 #ifdef ERTS_SMP
 static void copy_literals_commit(void*);
 #endif
 
-copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE};
-
 /* copy literals
  *
  * copy_literals.ptr = LitPtr
@@ -1157,12 +1554,19 @@ copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE};
  *  ...
  */
 
+#endif
 
 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;
 
+    if (BIF_P != erts_code_purger)
+	BIF_ERROR(BIF_P, EXC_NOTSUP);
+
     if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) {
         BIF_ERROR(BIF_P, BADARG);
     }
@@ -1180,22 +1584,13 @@ BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
             res = am_false;
             goto done;
         }
-        if (erts_clrange.ptr != NULL
-            && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) {
+        if (erts_copy_literal_area) {
             res = am_aborted;
             goto done;
         }
-        erts_clrange.ptr = modp->old.code_hdr->literal_area->start;
-        erts_clrange.sz  = modp->old.code_hdr->literal_area->end - erts_clrange.ptr;
-        erts_clrange.pid = BIF_P->common.id;
+	erts_copy_literal_area = modp->old.code_hdr->literal_area;
     } 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;
+	erts_copy_literal_area = NULL;
     }
 
 #ifdef ERTS_SMP
@@ -1209,8 +1604,11 @@ BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
 done:
     erts_release_code_write_permission();
     BIF_RET(res);
+#endif
 }
 
+#ifndef ERTS_NEW_PURGE_STRATEGY
+
 #ifdef ERTS_SMP
 static void copy_literals_commit(void* null) {
     Process* p = committer_state.stager;
@@ -1227,6 +1625,7 @@ static void copy_literals_commit(void* null) {
 }
 #endif /* ERTS_SMP */
 
+#endif
 
 /* Do the actualy module purging and return:
  * true for success
@@ -1241,6 +1640,7 @@ BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
     Module* modp;
     int is_blocking = 0;
     Eterm ret;
+    ErtsLiteralArea *literals = NULL;
 
     if (is_not_atom(BIF_ARG_1)) {
 	BIF_ERROR(BIF_P, BADARG);
@@ -1294,7 +1694,7 @@ BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
 	    erts_cleanup_funs_on_purge(code, end);
 	    beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
 				code_ix);
-	    erts_release_literal_area(modp->old.code_hdr->literal_area);
+	    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;
@@ -1310,6 +1710,38 @@ BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
 	erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
     }
     erts_release_code_write_permission();
+
+#ifdef 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);
+    }
+
+#else /* !ERTS_NEW_PURGE_STRATEGY */
+
+    erts_release_literal_area(literals);
+
+#endif
+
     return ret;
 }
 
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 336f097f0f..d52f12e6d0 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -50,6 +50,7 @@ extern BeamInstr* em_call_error_handler;
 extern BeamInstr* em_apply_bif;
 extern BeamInstr* em_call_nif;
 
+struct ErtsLiteralArea_;
 
 /*
  * The following variables keep a sorted list of address ranges for
@@ -60,15 +61,6 @@ extern BeamInstr* em_call_nif;
 /* Total code size in bytes */
 extern Uint erts_total_code_size;
 
-typedef struct {
-    struct erl_off_heap_header *off_heap;
-    Eterm *end;
-    Eterm start[1]; /* beginning of area */
-} ErtsLiteralArea;
-
-#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
-    (sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
-
 typedef struct BeamCodeLineTab_ BeamCodeLineTab;
 
 /*
@@ -98,7 +90,7 @@ typedef struct beam_code_header {
     /*
      * Literal area (constant pool).
      */
-    ErtsLiteralArea *literal_area;
+    struct ErtsLiteralArea_ *literal_area;
 
     /*
      * Pointer to the on_load function (or NULL if none).
@@ -127,9 +119,11 @@ typedef struct beam_code_header {
 
 }BeamCodeHeader;
 
-void erts_release_literal_area(ErtsLiteralArea* literal_area);
+void erts_release_literal_area(struct ErtsLiteralArea_* literal_area);
 int erts_is_module_native(BeamCodeHeader* code);
 
+void erts_beam_bif_load_init(void);
+
 /*
  * Layout of the line table.
  */
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 065018514a..7ffcb26567 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -174,6 +174,8 @@ bif erts_internal:is_system_process/1
 
 bif erts_internal:system_check/1
 
+bif erts_internal:release_literal_area_switch/0
+
 # inet_db support
 bif erlang:port_set_data/2
 bif erlang:port_get_data/1
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 227fedfb69..0a4a34a174 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -367,6 +367,7 @@ type	MONITOR_LH	STANDARD	PROCESSES	monitor_lh
 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	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_init.c b/erts/emulator/beam/erl_init.c
index fbdafec4ef..788dbc3328 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -384,6 +384,7 @@ erl_init(int ncpu,
     erts_init_unicode(); /* after RE to get access to PCRE unicode */
     erts_init_external();
     erts_init_map();
+    erts_beam_bif_load_init();
     erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2);
     erts_late_init_process();
 #if HAVE_ERTS_MSEG
@@ -2250,7 +2251,27 @@ erl_start(int argc, char **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");
+    {
+	/*
+	 * The erts_code_purger and the erts_literal_area_collector
+	 * system processes are *always* alive. If they terminate
+	 * they bring the whole VM down.
+	 */
+	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_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_proc_inc_refc(erts_literal_area_collector);
+#endif
+
+    }
 
 #ifdef ERTS_SMP
     erts_start_schedulers();
@@ -2350,14 +2371,15 @@ erts_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2)
     if (erts_mtrace_enabled)
 	erts_mtrace_exit((Uint32) n);
 
+    if (fmt != NULL && *fmt != '\0')
+	  erl_error(fmt, args2);	/* Print error message. */
+
     /* Produce an Erlang core dump if error */
     if (((n == ERTS_ERROR_EXIT && erts_no_crash_dump == 0) || n == ERTS_DUMP_EXIT)
 	&& erts_initialized) {
 	erl_crash_dump_v((char*) NULL, 0, fmt, args1);
     }
 
-    if (fmt != NULL && *fmt != '\0')
-	  erl_error(fmt, args2);	/* Print error message. */
     sys_tty_reset(n);
 
     if (n == ERTS_INTR_EXIT)
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 39c0617143..4192cf389f 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -112,6 +112,9 @@ static erts_lc_lock_order_t erts_lock_order[] = {
     {	"export_tab",				NULL			},
     {	"fun_tab",				NULL			},
     {	"environ",				NULL			},
+#ifdef ERTS_NEW_PURGE_STRATEGY
+    {	"release_literal_areas",		NULL			},
+#endif
 #endif
     {	"efile_drv",				"address"		},
     {	"drv_ev_state_grow",			NULL,   		},
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 66f22979ad..42c30b935e 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -448,6 +448,9 @@ int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP;
 typedef enum {
     ERTS_PSTT_GC,	/* Garbage Collect */
     ERTS_PSTT_CPC,	/* Check Process Code */
+#ifdef ERTS_NEW_PURGE_STRATEGY
+    ERTS_PSTT_CLA,	/* Copy Literal Area */
+#endif
     ERTS_PSTT_COHMQ,    /* Change off heap message queue */
     ERTS_PSTT_FTMQ      /* Flush trace msg queue */
 } ErtsProcSysTaskType;
@@ -10393,6 +10396,27 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
 	    }
 	    break;
         }
+#ifdef ERTS_NEW_PURGE_STRATEGY
+	case ERTS_PSTT_CLA: {
+	    int fcalls;
+            int cla_reds = 0;
+	    if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+		fcalls = reds;
+	    else
+		fcalls = reds - CONTEXT_REDS;
+	    st_res = erts_proc_copy_literal_area(c_p,
+						 &cla_reds,
+						 fcalls,
+						 st->arg[0] == am_true);
+            reds -= cla_reds;
+	    if (is_non_value(st_res)) {
+		/* Needed gc, but gc was disabled */
+		save_gc_task(c_p, st, st_prio);
+		st = NULL;
+	    }
+	    break;
+        }
+#endif
 	case ERTS_PSTT_COHMQ:
 	    reds -= erts_complete_off_heap_message_queue_change(c_p);
 	    st_res = am_true;
@@ -10443,14 +10467,15 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
 
 	switch (st->type) {
 	case ERTS_PSTT_GC:
-	    st_res = am_false;
-	    break;
 	case ERTS_PSTT_CPC:
-	    st_res = am_false;
-	    break;
 	case ERTS_PSTT_COHMQ:
 	    st_res = am_false;
 	    break;
+#ifdef ERTS_NEW_PURGE_STRATEGY
+	case ERTS_PSTT_CLA:
+	    st_res = am_ok;
+	    break;
+#endif
 #ifdef ERTS_SMP
         case ERTS_PSTT_FTMQ:
 	    reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN);
@@ -10572,6 +10597,17 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
 	    goto noproc;
 	break;
 
+#ifdef ERTS_NEW_PURGE_STRATEGY
+    case am_copy_literals:
+	if (st->arg[0] != am_true && st->arg[0] != am_false)
+	    goto badarg;
+	st->type = ERTS_PSTT_CLA;
+	noproc_res = am_ok;
+	if (!rp)
+	    goto noproc;
+	break;
+#endif
+
     default:
 	goto badarg;
     }
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index f3d4ac56cd..00dfc421d5 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -999,17 +999,27 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
 
 /* beam_bif_load.c */
 #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)
+#define ERTS_CPC_ALL           ERTS_CPC_ALLOW_GC
 Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls);
+#ifdef ERTS_NEW_PURGE_STRATEGY
+Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed);
+#endif
 
-typedef struct {
-    Eterm *ptr;
-    Uint   sz;
-    Eterm pid;
-} copy_literals_t;
+typedef struct ErtsLiteralArea_ {
+    struct erl_off_heap_header *off_heap;
+    Eterm *end;
+    Eterm start[1]; /* beginning of area */
+} ErtsLiteralArea;
 
-extern copy_literals_t erts_clrange;
+#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
+    (sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
+
+extern ErtsLiteralArea *erts_copy_literal_area;
+#ifdef ERTS_NEW_PURGE_STRATEGY
+extern Process *erts_literal_area_collector;
+#endif
+
+extern Process *erts_code_purger;
 
 /* beam_load.c */
 typedef struct {
@@ -1092,12 +1102,19 @@ typedef struct {
 
 #define INITIALIZE_SHCOPY(info)                         \
 do {                                                    \
+    ErtsLiteralArea *larea__ = erts_copy_literal_area;	\
     info.queue_start = info.queue_default;              \
     info.bitstore_start = info.bitstore_default;        \
     info.shtable_start = info.shtable_default;          \
     info.literal_size = 0;                              \
-    info.range_ptr = erts_clrange.ptr;                  \
-    info.range_sz  = erts_clrange.sz;                   \
+    if (larea__) {					\
+	info.range_ptr = &larea__->start[0];		\
+	info.range_sz = larea__->end - info.range_ptr;	\
+    }							\
+    else {						\
+	info.range_ptr = NULL;				\
+	info.range_sz = 0;				\
+    }							\
 } while(0)
 
 #define DESTROY_SHCOPY(info)                                            \
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
index a0da864824..9133fd9853 100644
Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index d897c8e92f..3349d05385 100644
Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ
diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam
new file mode 100644
index 0000000000..71f3c2ec8c
Binary files /dev/null and b/erts/preloaded/ebin/erts_literal_area_collector.beam differ
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index 4a447d3a09..df4645070b 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -44,7 +44,8 @@ PRE_LOADED_ERL_MODULES = \
 	erts_code_purger \
 	erlang \
 	erts_internal \
-	erl_tracer
+	erl_tracer \
+	erts_literal_area_collector
 
 PRE_LOADED_BEAM_MODULES = \
 	prim_eval
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index e18da28905..7ab06164b4 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -37,7 +37,7 @@
 	{registered, []},
 	{applications, []},
 	{env, []},
-	{runtime_dependencies, ["stdlib-3.0", "kernel-5.0", "sasl-3.0"]}
+	{runtime_dependencies, ["stdlib-3.0", "kernel-5.0", "sasl-3.0.1"]}
     ]}.
 
 %% vim: ft=erlang
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
index d1e64342e0..f9208624b7 100644
--- a/erts/preloaded/src/erts_code_purger.erl
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -28,7 +28,36 @@
 start() ->
     register(erts_code_purger, self()),
     process_flag(trap_exit, true),
-    loop().
+    try
+	%% Pass bad arguments to copy_literals() in
+	%% order to determine purge strategy used
+	%% by the VM...
+	Res = erts_internal:copy_literals(4711, badarg),
+	exit({copy_literals_returned, Res})
+    catch
+	error : badarg -> %% VM use old purge strategy
+	    old_loop();
+	error : notsup -> %% VM use new purge strategy
+	    loop();
+	Type : Reason ->
+	    %% This should not be possible...
+	    exit({"Unexpected copy_literals() behaviour",
+		  {Type, Reason}})
+    end.
+
+old_loop() ->
+    _ = receive
+	{purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+	    Res = do_old_purge(Mod),
+	    From ! {reply, purge, Res, Ref};
+
+	{soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+	    Res = do_old_soft_purge(Mod),
+	    From ! {reply, soft_purge, Res, Ref};
+
+	_Other -> ignore
+    end,
+    old_loop().
 
 loop() ->
     _ = receive
@@ -61,7 +90,7 @@ purge(Mod) when is_atom(Mod) ->
     end.
 
 
-do_purge(Mod) ->
+do_old_purge(Mod) ->
     case erts_internal:copy_literals(Mod, true) of
         false ->
             {false, false};
@@ -72,6 +101,11 @@ do_purge(Mod) ->
             {WasPurged, DidKill}
     end.
 
+do_purge(Mod) ->
+    DidKill = check_proc_code(erlang:processes(), Mod, true),
+    WasPurged = erts_internal:purge_module(Mod),
+    {WasPurged, DidKill}.
+
 %% 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
@@ -86,7 +120,7 @@ soft_purge(Mod) ->
     end.
 
 
-do_soft_purge(Mod) ->
+do_old_soft_purge(Mod) ->
     case erts_internal:copy_literals(Mod, true) of
 	false ->
 	    true;
@@ -102,6 +136,12 @@ do_soft_purge(Mod) ->
 	    end
     end.
 
+do_soft_purge(Mod) ->
+    case check_proc_code(erlang:processes(), Mod, false) of
+	false -> false;
+	true -> erts_internal:purge_module(Mod)
+    end.
+
 %%
 %% check_proc_code(Pids, Mod, Hard) - Send asynchronous
 %%   requests to all processes to perform a check_process_code
@@ -283,8 +323,7 @@ cpc_sched_kill(Pid,
 
 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}]).
+						{allow_gc, AllowGc}]).
 
 cpc_request_gc(CpcS, [Pid|Pids]) ->
     cpc_request(CpcS, Pid, true),
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 2459ea2a2c..2bf430d857 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -42,6 +42,7 @@
 
 -export([check_process_code/3]).
 -export([copy_literals/2]).
+-export([release_literal_area_switch/0]).
 -export([purge_module/1]).
 
 -export([flush_monitor_messages/3]).
@@ -211,7 +212,6 @@ request_system_task(_Pid, _Prio, _Request) ->
     erlang:nif_error(undefined).
 
 -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(),
@@ -223,7 +223,7 @@ check_process_code(_Module, _Flags) ->
       Pid :: pid(),
       Module :: module(),
       RequestId :: term(),
-      Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()},
+      Option :: {async, RequestId} | {allow_gc, boolean()},
       OptionList :: [Option],
       CheckResult :: boolean() | aborted.
 check_process_code(Pid, Module, OptionList)  ->
@@ -265,8 +265,6 @@ 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}.
 
@@ -281,6 +279,11 @@ cpc_flags(OldFlags, Bit, false) ->
 copy_literals(_Mod, _Bool) ->
     erlang:nif_error(undefined).
 
+-spec release_literal_area_switch() -> 'true' | 'false'.
+
+release_literal_area_switch() ->
+    erlang:nif_error(undefined).
+
 -spec purge_module(Module) -> boolean() when
       Module :: module().
 purge_module(_Module) ->
diff --git a/erts/preloaded/src/erts_literal_area_collector.erl b/erts/preloaded/src/erts_literal_area_collector.erl
new file mode 100644
index 0000000000..3befad8dfb
--- /dev/null
+++ b/erts/preloaded/src/erts_literal_area_collector.erl
@@ -0,0 +1,113 @@
+%%
+%% %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_literal_area_collector).
+
+-export([start/0]).
+
+%% Currently we only allow two outstanding literal
+%% copying jobs that garbage collect in order to
+%% copy the literals. Maybe we could allow more
+%% than two outstanding processes, but for now we
+%% play it safe...
+-define(MAX_GC_OUTSTND, 2).
+
+%%
+%% The erts_literal_area_collector is started at
+%% VM boot by the VM. It is a spawned as a system
+%% process, i.e, the whole VM will terminate if
+%% this process terminates.
+%%
+start() ->
+    process_flag(trap_exit, true),
+    msg_loop(undefined, 0, 0, []).
+
+%%
+%% The VM will send us a 'copy_literals' message
+%% when it has a new literal area that needs to
+%% be handled is added. We will also be informed
+%% about more areas when we call
+%% erts_internal:release_literal_area_switch().
+%%
+msg_loop(Area, Outstnd, GcOutstnd, NeedGC) ->
+    receive
+
+	%% A new area to handle has arrived...
+	copy_literals when Outstnd == 0 ->
+	    switch_area();
+
+	%% Process (_Pid) has completed the request...
+	{copy_literals, {Area, _GcAllowed, _Pid}, ok} when Outstnd == 1 ->
+	    switch_area(); %% Last process completed...
+	{copy_literals, {Area, false, _Pid}, ok} ->
+	    msg_loop(Area, Outstnd-1, GcOutstnd, NeedGC);
+	{copy_literals, {Area, true, _Pid}, ok} when NeedGC == [] ->
+	    msg_loop(Area, Outstnd-1, GcOutstnd-1, []);
+	{copy_literals, {Area, true, _Pid}, ok} ->
+	    send_copy_req(hd(NeedGC), Area, true),
+	    msg_loop(Area, Outstnd-1, GcOutstnd, tl(NeedGC));
+
+	%% Process (Pid) failed to complete the request
+	%% since it needs to garbage collect in order to
+	%% complete the request...
+	{copy_literals, {Area, false, Pid}, need_gc} when GcOutstnd < ?MAX_GC_OUTSTND ->
+	    send_copy_req(Pid, Area, true),
+	    msg_loop(Area, Outstnd, GcOutstnd+1, NeedGC);
+	{copy_literals, {Area, false, Pid}, need_gc} ->
+	    msg_loop(Area, Outstnd, GcOutstnd, [Pid|NeedGC]);
+
+	%% Not handled message regarding the area that we
+	%% currently are working with. Crash the VM so
+	%% we notice this bug...
+	{copy_literals, {Area, _, _}, _} = Msg when erlang:is_reference(Area) ->
+	    exit({not_handled_message, Msg});
+
+	%% Unexpected garbage message. Get rid of it...
+	_Ignore ->
+	    msg_loop(Area, Outstnd, GcOutstnd, NeedGC)
+
+    end.
+
+switch_area() ->
+    Res = erts_internal:release_literal_area_switch(),
+    erlang:garbage_collect(), %% Almost no live data now...
+    case Res of
+	false ->
+	    %% No more areas to handle...
+	    msg_loop(undefined, 0, 0, []);
+	true ->
+	    %% Send requests to all processes to copy
+	    %% all live data they have referring to the
+	    %% literal area that is to be released...
+	    Area = make_ref(),
+	    Outstnd = send_copy_reqs(erlang:processes(), Area, false),
+	    msg_loop(Area, Outstnd, 0, [])
+    end.
+
+send_copy_reqs(Ps, Area, GC) ->
+    send_copy_reqs(Ps, Area, GC, 0).
+
+send_copy_reqs([], _Area, _GC, N) ->
+    N;
+send_copy_reqs([P|Ps], Area, GC, N) ->
+    send_copy_req(P, Area, GC),
+    send_copy_reqs(Ps, Area, GC, N+1).
+
+send_copy_req(P, Area, GC) ->
+    erts_internal:request_system_task(P, normal, {copy_literals, {Area, GC, P}, GC}).
diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl
index 1370e23195..b96de94427 100644
--- a/lib/kernel/test/init_SUITE.erl
+++ b/lib/kernel/test/init_SUITE.erl
@@ -27,7 +27,8 @@
 -export([get_arguments/1, get_argument/1, boot_var/1, restart/1,
 	 many_restarts/0, many_restarts/1,
 	 get_plain_arguments/1,
-	 reboot/1, stop_status/1, stop/1, get_status/1, script_id/1]).
+	 reboot/1, stop_status/1, stop/1, get_status/1, script_id/1,
+	 find_system_processes/0]).
 -export([boot1/1, boot2/1]).
 
 -export([init_per_testcase/2, end_per_testcase/2]).
@@ -355,12 +356,16 @@ wait_for(N,Node,EHPid) ->
 restart(Config) when is_list(Config) ->
     Args = args(),
 
+    Pa = " -pa " ++ filename:dirname(code:which(?MODULE)),
+
     %% Currently test_server:start_node cannot be used. The restarted
     %% node immediately halts due to the implementation of
     %% test_server:start_node.
-    {ok, Node} = loose_node:start(init_test, Args, ?DEFAULT_TIMEOUT_SEC),
+    {ok, Node} = loose_node:start(init_test, Args ++ Pa, ?DEFAULT_TIMEOUT_SEC),
     %% Ok, the node is up, now the real test test begins.
     erlang:monitor_node(Node, true),
+    SysProcs0 = rpc:call(Node, ?MODULE, find_system_processes, []),
+    [InitPid, PurgerPid, LitCollectorPid] = SysProcs0,
     InitPid = rpc:call(Node, erlang, whereis, [init]),
     PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]),
     Procs = rpc:call(Node, erlang, processes, []),
@@ -375,6 +380,9 @@ restart(Config) when is_list(Config) ->
     end,
     ok = wait_restart(30, Node),
 
+    SysProcs1 = rpc:call(Node, ?MODULE, find_system_processes, []),
+    [InitPid1, PurgerPid1, LitCollectorPid1] = SysProcs1,
+
     %% Still the same init process!
     InitPid1 = rpc:call(Node, erlang, whereis, [init]),
     InitP = pid_to_list(InitPid),
@@ -385,8 +393,16 @@ restart(Config) when is_list(Config) ->
     PurgerP = pid_to_list(PurgerPid),
     PurgerP = pid_to_list(PurgerPid1),
 
+    %% and same literal area collector process!
+    case LitCollectorPid of
+	undefined -> undefined = LitCollectorPid1;
+	_ ->
+	    LitCollectorP = pid_to_list(LitCollectorPid),
+	    LitCollectorP = pid_to_list(LitCollectorPid1)
+    end,
+
     NewProcs0 = rpc:call(Node, erlang, processes, []),
-    NewProcs = NewProcs0 -- [InitPid1, PurgerPid1],
+    NewProcs = NewProcs0 -- SysProcs1,
     case check_processes(NewProcs, MaxPid) of
 	true ->
 	    ok;
@@ -406,6 +422,32 @@ restart(Config) when is_list(Config) ->
     loose_node:stop(Node),
     ok.
 
+-record(sys_procs, {init,
+		    code_purger,
+		    literal_collector}).
+
+find_system_processes() ->
+    find_system_procs(processes(), #sys_procs{}).
+
+find_system_procs([], SysProcs) ->
+    [SysProcs#sys_procs.init,
+     SysProcs#sys_procs.code_purger,
+     SysProcs#sys_procs.literal_collector];
+find_system_procs([P|Ps], SysProcs) ->
+    case process_info(P, initial_call) of
+	{initial_call,{otp_ring0,start,2}} ->
+	    undefined = SysProcs#sys_procs.init,
+	    find_system_procs(Ps, SysProcs#sys_procs{init = P});
+	{initial_call,{erts_code_purger,start,0}} ->
+	    undefined = SysProcs#sys_procs.code_purger,
+	    find_system_procs(Ps, SysProcs#sys_procs{code_purger = P});
+	{initial_call,{erts_literal_area_collector,start,0}} ->
+	    undefined = SysProcs#sys_procs.literal_collector,
+	    find_system_procs(Ps, SysProcs#sys_procs{literal_collector = P});
+	_ ->
+	    find_system_procs(Ps, SysProcs)
+    end.
+
 wait_restart(0, _Node) ->
     ct:fail(not_restarted);
 wait_restart(N, Node) ->
diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src
index 4ee8a7d6c8..633cdfa070 100644
--- a/lib/sasl/src/sasl.app.src
+++ b/lib/sasl/src/sasl.app.src
@@ -46,5 +46,5 @@
            {errlog_type, all}]},
     {mod, {sasl, []}},
     {runtime_dependencies, ["tools-2.6.14","stdlib-3.0","kernel-5.0",
-			    "erts-8.0"]}]}.
+			    "erts-8.1"]}]}.
 
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 352e4984df..29fccca741 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1492,7 +1492,8 @@ preloaded() ->
     %% Sorted
     [erl_prim_loader,erl_tracer,erlang,
      erts_code_purger,
-     erts_internal,init,otp_ring0,prim_eval,prim_file,
+     erts_internal,erts_literal_area_collector,
+     init,otp_ring0,prim_eval,prim_file,
      prim_inet,prim_zip,zlib].
 
 %%______________________________________________________________________
-- 
cgit v1.2.3


From 9d0638216d35ca0f21c1eea20f8daa3992ac4f71 Mon Sep 17 00:00:00 2001
From: Rickard Green <rickard@erlang.org>
Date: Tue, 2 Aug 2016 15:58:06 +0200
Subject: 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.
---
 HOWTO/INSTALL.md                                   |   4 +
 erts/doc/src/erlang.xml                            |  23 +
 erts/emulator/beam/atom.names                      |   5 +
 erts/emulator/beam/beam_bif_load.c                 | 614 +++++++++++++--------
 erts/emulator/beam/beam_emu.c                      |  49 +-
 erts/emulator/beam/beam_load.h                     |   4 +-
 erts/emulator/beam/bif.tab                         |   3 +-
 erts/emulator/beam/erl_alloc.types                 |   1 +
 erts/emulator/beam/erl_bif_info.c                  |  21 +
 erts/emulator/beam/erl_fun.c                       |  53 +-
 erts/emulator/beam/erl_fun.h                       |   6 +-
 erts/emulator/beam/erl_init.c                      |  13 +-
 erts/emulator/beam/erl_lock_check.c                |   1 +
 erts/emulator/test/code_SUITE.erl                  | 223 +++++++-
 .../emulator/test/code_SUITE_data/my_code_test.erl |   2 -
 .../test/code_SUITE_data/my_code_test2.erl         |  32 ++
 erts/preloaded/ebin/erts_code_purger.beam          | Bin 9904 -> 11168 bytes
 erts/preloaded/ebin/erts_internal.beam             | Bin 10576 -> 10432 bytes
 erts/preloaded/ebin/init.beam                      | Bin 50048 -> 50048 bytes
 erts/preloaded/src/erts_code_purger.erl            | 184 +++---
 erts/preloaded/src/erts_internal.erl               |  16 +-
 erts/preloaded/src/init.erl                        |   4 +-
 lib/kernel/doc/src/code.xml                        |  10 +
 lib/tools/test/cover_SUITE.erl                     |  33 +-
 lib/tools/test/cover_SUITE_data/otp_6115/f1.erl    |  15 +-
 lib/tools/test/cover_SUITE_data/otp_6115/f2.erl    |  14 +-
 26 files changed, 920 insertions(+), 410 deletions(-)
 create mode 100644 erts/emulator/test/code_SUITE_data/my_code_test2.erl

diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md
index 8632f46264..551ecdd224 100644
--- a/HOWTO/INSTALL.md
+++ b/HOWTO/INSTALL.md
@@ -429,6 +429,10 @@ Some of the available `configure` options are:
     and **not supported**. This functionality **will** be subject to backward
     incompatible changes. Note that you should **not** enable the dirty scheduler
     functionality on production systems. It is only provided for testing.
+    This switch also imply `--enable-new-purge-strategy` (see below).
+*   `--enable-new-purge-strategy` - Enable the purge strategy that will be
+    introduced in ERTS version 9.0 (OTP 20). Note that this switch will be
+    removed in OTP 20.
 
 If you or your system has special requirements please read the `Makefile` for
 additional configuration information.
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 6289f033b2..a146d4f2b1 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -764,6 +764,29 @@
             and the operation was requested
             by passing option <c>{allow_gc, false}</c>.</p></item>
         </taglist>
+	<note>
+	<p>
+	  Up until ERTS version 8.*, the check process code operation
+	  checks for all types of references to the old code. That is,
+	  direct references (e.g. return addresses on the process
+	  stack), indirect references (<c>fun</c>s in process
+	  context), and references to literals in the code.
+	</p>
+	<p>
+	  As of ERTS version 9.0, the check process code operation
+	  only checks for direct references to the code. Indirect
+	  references via <c>fun</c>s will be ignored. If such
+	  <c>fun</c>s exist and are used after a purge of the old
+	  code, an exception will be raised upon usage (same as
+	  the case when the <c>fun</c> is received by the process
+	  after the purge). Literals will be taken care of (copied)
+	  at a  later stage. This behavior can as of ERTS version
+	  8.1 be enabled when
+	  <seealso marker="doc/installation_guide:INSTALL#Advanced-configuration-and-build-of-ErlangOTP_Configuring">building OTP</seealso>,
+	  and will automatically be enabled if dirty scheduler
+	  support is enabled.
+	</p>
+	</note>
         <p>See also <seealso marker="kernel:code">code(3)</seealso>.</p>
         <p>Failures:</p>
         <taglist>
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                    },
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 2347a3d4ef..34515efa3d 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -20,7 +20,8 @@
 
 -module(code_SUITE).
 -export([all/0, suite/0, init_per_suite/1, end_per_suite/1, 
-         versions/1,new_binary_types/1,
+         versions/1,new_binary_types/1, call_purged_fun_code_gone/1,
+	 call_purged_fun_code_reload/1, call_purged_fun_code_there/1,
          t_check_process_code/1,t_check_old_code/1,
          t_check_process_code_ets/1,
          external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
@@ -34,7 +35,8 @@
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
-    [versions, new_binary_types, t_check_process_code,
+    [versions, new_binary_types, call_purged_fun_code_gone,
+     call_purged_fun_code_reload, call_purged_fun_code_there, t_check_process_code,
      t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
      module_md5, make_stub, make_stub_many_funs,
      constant_pools, constant_refc_binaries, false_dependency,
@@ -127,12 +129,169 @@ new_binary_types(Config) when is_list(Config) ->
                                                     bit_sized_binary(Bin))),
     ok.
 
+call_purged_fun_code_gone(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    call_purged_fun_test(Priv, Data, code_gone),
+    ok.
+
+call_purged_fun_code_reload(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    Path = code:get_path(),
+    true = code:add_path(Priv),
+    try
+	call_purged_fun_test(Priv, Data, code_reload)
+    after
+	code:set_path(Path)
+    end,
+    ok.
+
+call_purged_fun_code_there(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    call_purged_fun_test(Priv, Data, code_there),
+    ok.
+
+call_purged_fun_test(Priv, Data, Type) ->
+    File = filename:join(Data, "my_code_test2"),
+    Code = filename:join(Priv, "my_code_test2"),
+
+    catch erlang:purge_module(my_code_test2),
+    catch erlang:delete_module(my_code_test2),
+    catch erlang:purge_module(my_code_test2),
+
+    {ok,my_code_test2} = c:c(File, [{outdir,Priv}]),
+
+    T = ets:new(my_code_test2_fun_table, []),
+    ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}),
+    ets:insert(T, {my_fun2,my_code_test2:make_fun2()}),
+
+    spawn(fun () ->
+		  [{my_fun2,F2}] = ets:lookup(T, my_fun2),
+		  F2(fun () ->
+			     receive after infinity -> ok end
+		     end,
+		     fun () -> ok end),
+		  exit(completed)
+	  end),
+
+    PurgeType = case Type of
+		    code_gone ->
+			ok = file:delete(Code++".beam"),
+			true;
+		    code_reload ->
+			true;
+		    code_there ->
+			false
+		end,
+
+    true = erlang:delete_module(my_code_test2),
+
+    Purge = start_purge(my_code_test2, PurgeType),
+
+    {P0, M0} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4712 = F(1),
+				     exit(completed)
+			     end),
+
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P0, status)
+	       end),
+
+    ok = continue_purge(Purge),
+
+    {P1, M1} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4713 = F(2),
+				     exit(completed)
+			     end),
+    {P2, M2} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4714 = F(3),
+				     exit(completed)
+			     end),
+
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P1, status)
+	       end),
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P2, status)
+	       end),
+
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P0, current_function),
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P1, current_function),
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P2, current_function),
+
+    case Type of
+	code_there ->
+	    false = complete_purge(Purge);
+	_ ->
+	    {true, true} = complete_purge(Purge)
+    end,
+
+    case Type of
+	code_gone ->
+	    receive
+		{'DOWN', M0, process, P0, Reason0} ->
+		    {undef, _} = Reason0
+	    end,
+	    receive
+		{'DOWN', M1, process, P1, Reason1} ->
+		    {undef, _} = Reason1
+	    end,
+	    receive
+		{'DOWN', M2, process, P2, Reason2} ->
+		    {undef, _} = Reason2
+	    end;
+	_ ->
+	    receive
+		{'DOWN', M0, process, P0, Reason0} ->
+		    completed = Reason0
+	    end,
+	    receive
+		{'DOWN', M1, process, P1, Reason1} ->
+		    completed = Reason1
+	    end,
+	    receive
+		{'DOWN', M2, process, P2, Reason2} ->
+		    completed = Reason2
+	    end,
+	    catch erlang:purge_module(my_code_test2),
+	    catch erlang:delete_module(my_code_test2),
+	    catch erlang:purge_module(my_code_test2)
+    end,
+    ok.
+
 t_check_process_code(Config) when is_list(Config) ->
+    case check_process_code_handle(indirect_references) of
+	false -> {skipped, "check_process_code() ignores funs"};
+	true -> t_check_process_code_test(Config)
+    end.
+
+t_check_process_code_test(Config) ->
     Priv = proplists:get_value(priv_dir, Config),
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
     Code = filename:join(Priv, "my_code_test"),
 
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+
     {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
 
     MyFun = fun(X, Y) -> X + Y end,	%Confuse things.
@@ -231,11 +390,16 @@ gc1() -> ok.
 
 %% Test check_process_code/2 in combination with a fun obtained from an ets table.
 t_check_process_code_ets(Config) when is_list(Config) ->
-    case test_server:is_native(?MODULE) of
-        true ->
-            {skip,"Native code"};
-        false ->
-            do_check_process_code_ets(Config)
+    case check_process_code_handle(indirect_references) of
+	false ->
+	    {skipped, "check_process_code() ignores funs"};
+	true ->
+	    case test_server:is_native(?MODULE) of
+		true ->
+		    {skip,"Native code"};
+		false ->
+		    do_check_process_code_ets(Config)
+	    end
     end.
 
 do_check_process_code_ets(Config) ->
@@ -243,8 +407,9 @@ do_check_process_code_ets(Config) ->
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
 
-    erlang:purge_module(my_code_test),
-    erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
     {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
 
     T = ets:new(my_code_test, []),
@@ -295,8 +460,8 @@ t_check_old_code(Config) when is_list(Config) ->
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
 
-    erlang:purge_module(my_code_test),
-    erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
     catch erlang:purge_module(my_code_test),
 
     false = erlang:check_old_code(my_code_test),
@@ -971,3 +1136,39 @@ flush() ->
     receive _ -> flush() after 0 -> ok end.
 
 id(I) -> I.
+
+check_process_code_handle(What) ->
+    lists:member(What, erlang:system_info(check_process_code)).
+
+wait_until(Fun) ->
+    case Fun() of
+	true ->
+	    ok;
+	false ->
+	    receive after 100 -> ok end,
+	    wait_until(Fun)
+    end.
+
+start_purge(Mod, Type) when is_atom(Mod)
+			    andalso ((Type == true)
+				     orelse (Type == false)) ->
+    Ref = make_ref(),
+    erts_code_purger ! {test_purge, Mod, self(), Type, Ref},
+    receive
+	{started, Ref} ->
+	    Ref
+    end.
+
+continue_purge(Ref) when is_reference(Ref) ->
+    erts_code_purger ! {continue, Ref},
+    receive
+	{continued, Ref} ->
+	    ok
+    end.
+
+complete_purge(Ref) when is_reference(Ref) ->
+    erts_code_purger ! {complete, Ref},
+    receive
+	{test_purge, Res, Ref} ->
+	    Res
+    end.
diff --git a/erts/emulator/test/code_SUITE_data/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl
index d2386157d6..9d12aa9897 100644
--- a/erts/emulator/test/code_SUITE_data/my_code_test.erl
+++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl
@@ -24,5 +24,3 @@
 
 make_fun(A) ->
     fun(X) -> A + X end.
-
-	    
diff --git a/erts/emulator/test/code_SUITE_data/my_code_test2.erl b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
new file mode 100644
index 0000000000..57973535d4
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1999-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(my_code_test2).
+
+-export([make_fun/1, make_fun2/0]).
+
+make_fun(A) ->
+    fun(X) -> A + X end.
+
+make_fun2() ->
+    fun (F1,F2) ->
+	    F1(),
+	    F2()
+    end.
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
index 9133fd9853..a1eb126098 100644
Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 3349d05385..8d4ca152de 100644
Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index b856bff4fe..acff82fd98 100644
Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
index f9208624b7..ee4fcedd2d 100644
--- a/erts/preloaded/src/erts_code_purger.erl
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -22,42 +22,13 @@
 %% Purpose : Implement system process erts_code_purger
 %%           to handle code module purging.
 
--export([start/0, purge/1, soft_purge/1]).
+-export([start/0, purge/1, soft_purge/1, pending_purge_lambda/3]).
 
 -spec start() -> term().
 start() ->
     register(erts_code_purger, self()),
     process_flag(trap_exit, true),
-    try
-	%% Pass bad arguments to copy_literals() in
-	%% order to determine purge strategy used
-	%% by the VM...
-	Res = erts_internal:copy_literals(4711, badarg),
-	exit({copy_literals_returned, Res})
-    catch
-	error : badarg -> %% VM use old purge strategy
-	    old_loop();
-	error : notsup -> %% VM use new purge strategy
-	    loop();
-	Type : Reason ->
-	    %% This should not be possible...
-	    exit({"Unexpected copy_literals() behaviour",
-		  {Type, Reason}})
-    end.
-
-old_loop() ->
-    _ = receive
-	{purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
-	    Res = do_old_purge(Mod),
-	    From ! {reply, purge, Res, Ref};
-
-	{soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
-	    Res = do_old_soft_purge(Mod),
-	    From ! {reply, soft_purge, Res, Ref};
-
-	_Other -> ignore
-    end,
-    old_loop().
+    loop().
 
 loop() ->
     _ = receive
@@ -69,10 +40,43 @@ loop() ->
 	    Res = do_soft_purge(Mod),
 	    From ! {reply, soft_purge, Res, Ref};
 
+	{test_purge, Mod, From, Type, Ref} when is_atom(Mod), is_pid(From) ->
+	     do_test_purge(Mod, From, Type, Ref);
+
 	_Other -> ignore
     end,
     loop().
 
+%%
+%% Processes that tries to call a fun that belongs to
+%% a module that currently is being purged will end
+%% up here (pending_purge_lambda) in a suspended state.
+%% When the purge operation completes or aborts (soft
+%% purge that failed) these processes will be resumed.
+%%
+pending_purge_lambda(_Module, Fun, Args) ->
+    %%
+    %% When the process is resumed, the following
+    %% scenarios exist:
+    %% * The code that the fun refers to is still
+    %%   there due to a failed soft purge. The
+    %%   call to the fun will succeed via apply/2.
+    %% * The code was purged, and a current version
+    %%   of the module is loaded which does not
+    %%   contain this fun. The call will result
+    %%   in an exception being raised.
+    %% * The code was purged, and no current
+    %%   version of the module is loaded. An attempt
+    %%   to load the module (via the error_handler)
+    %%   will be made. This may or may not succeed.
+    %%   If the module is loaded, it may or may
+    %%   not contain the fun. The call will
+    %%   succeed if the error_handler was able
+    %%   to load the module and loaded module
+    %%   contains this fun; otherwise, an exception
+    %%   will be raised.
+    %%
+    apply(Fun, Args).
 
 %% purge(Module)
 %%  Kill all processes running code from *old* Module, and then purge the
@@ -89,22 +93,15 @@ purge(Mod) when is_atom(Mod) ->
 	    Result
     end.
 
-
-do_old_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.
-
 do_purge(Mod) ->
-    DidKill = check_proc_code(erlang:processes(), Mod, true),
-    WasPurged = erts_internal:purge_module(Mod),
-    {WasPurged, DidKill}.
+    case erts_internal:purge_module(Mod, prepare) of
+	false ->
+	    {false, false};
+	true ->
+	    DidKill = check_proc_code(erlang:processes(), Mod, true),
+	    true = erts_internal:purge_module(Mod, complete),
+	    {true, DidKill}
+    end.
 
 %% soft_purge(Module)
 %% Purge old code only if no procs remain that run old code.
@@ -119,27 +116,17 @@ soft_purge(Mod) ->
 	    Result
     end.
 
-
-do_old_soft_purge(Mod) ->
-    case erts_internal:copy_literals(Mod, true) of
+do_soft_purge(Mod) ->
+    case erts_internal:purge_module(Mod, prepare) 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.
-
-do_soft_purge(Mod) ->
-    case check_proc_code(erlang:processes(), Mod, false) of
-	false -> false;
-	true -> erts_internal:purge_module(Mod)
+	    Res = check_proc_code(erlang:processes(), Mod, false),
+	    erts_internal:purge_module(Mod,
+				       case Res of
+					   false -> abort;
+					   true -> complete
+				       end)
     end.
 
 %%
@@ -336,3 +323,72 @@ cpc_init(CpcS, [Pid|Pids], NoReqs) ->
     cpc_init(CpcS, Pids, NoReqs+1).
 
 % end of check_proc_code() implementation.
+
+%%
+%% FOR TESTING ONLY
+%%
+%% do_test_purge() is for testing only. The purge is done
+%% as usual, but the tester can control when to enter the
+%% specific phases.
+%%
+do_test_purge(Mod, From, Type, Ref) when Type == true; Type == false ->
+    Mon = erlang:monitor(process, From),
+    Res = case Type of
+	      true -> do_test_hard_purge(Mod, From, Ref, Mon);
+	      false -> do_test_soft_purge(Mod, From, Ref, Mon)
+	  end,
+    From ! {test_purge, Res, Ref},
+    erlang:demonitor(Mon, [flush]),
+    ok;
+do_test_purge(_, _, _, _) ->
+    ok.
+
+do_test_soft_purge(Mod, From, Ref, Mon) ->
+    PrepRes = erts_internal:purge_module(Mod, prepare),
+    TestRes = test_progress(started, From, Mon, Ref, ok),
+    case PrepRes of
+	false ->
+	    _ = test_progress(continued, From, Mon, Ref, TestRes),
+	    true;
+	true ->
+	    Res = check_proc_code(erlang:processes(), Mod, false),
+	    _ = test_progress(continued, From, Mon, Ref, TestRes),
+	    erts_internal:purge_module(Mod,
+				       case Res of
+					   false -> abort;
+					   true -> complete
+				       end)
+    end.
+
+do_test_hard_purge(Mod, From, Ref, Mon) ->
+    PrepRes = erts_internal:purge_module(Mod, prepare),
+    TestRes = test_progress(started, From, Mon, Ref, ok),
+    case PrepRes of
+	false ->
+	    _ = test_progress(continued, From, Mon, Ref, TestRes),
+	    {false, false};
+	true ->
+	    DidKill = check_proc_code(erlang:processes(), Mod, true),
+	    _ = test_progress(continued, From, Mon, Ref, TestRes),
+	    true = erts_internal:purge_module(Mod, complete),
+	    {true, DidKill}
+    end.
+
+test_progress(_State, _From, _Mon, _Ref, died) ->
+    %% Test process died; continue so we wont
+    %% leave the system in an inconsistent
+    %% state...
+    died;
+test_progress(started, From, Mon, Ref, ok) ->
+    From ! {started, Ref},
+    receive
+	{'DOWN', Mon, process, From, _} -> died;
+	{continue, Ref} -> ok
+    end;
+test_progress(continued, From, Mon, Ref, ok) ->
+    From ! {continued, Ref},
+    receive
+	{'DOWN', Mon, process, From, _} -> died;
+	{complete, Ref} -> ok
+    end.
+
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 2bf430d857..2a6d626279 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -41,9 +41,8 @@
 -export([request_system_task/3]).
 
 -export([check_process_code/3]).
--export([copy_literals/2]).
 -export([release_literal_area_switch/0]).
--export([purge_module/1]).
+-export([purge_module/2]).
 
 -export([flush_monitor_messages/3]).
 
@@ -273,20 +272,15 @@ cpc_flags(OldFlags, Bit, true) ->
 cpc_flags(OldFlags, Bit, false) ->
     OldFlags band (bnot Bit).
 
--spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
-      Module :: module(),
-      Bool :: boolean().
-copy_literals(_Mod, _Bool) ->
-    erlang:nif_error(undefined).
-
 -spec release_literal_area_switch() -> 'true' | 'false'.
 
 release_literal_area_switch() ->
     erlang:nif_error(undefined).
 
--spec purge_module(Module) -> boolean() when
-      Module :: module().
-purge_module(_Module) ->
+-spec purge_module(Module, Op) -> boolean() when
+      Module :: module(),
+      Op :: 'prepare' | 'abort' | 'complete'.
+purge_module(_Module, _Op) ->
     erlang:nif_error(undefined).
 
 -spec system_check(Type) -> 'ok' when
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 45468b3b9c..c3c2f22122 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -670,9 +670,9 @@ unload(_) ->
     do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
 
 do_unload([M|Mods]) ->
-    catch erts_internal:purge_module(M),
+    catch erlang:purge_module(M),
     catch erlang:delete_module(M),
-    catch erts_internal:purge_module(M),
+    catch erlang:purge_module(M),
     do_unload(Mods);
 do_unload([]) ->
     purge_all_hipe_refs(),
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index d3611d6a03..21f8a2d54a 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -651,6 +651,11 @@ ok = code:finish_loading(Prepared),
         <p>Purges the code for <c><anno>Module</anno></c>, that is, removes code
           marked as old. If some processes still linger in the old code,
           these processes are killed before the code is removed.</p>
+	<note><p>As of ERTS version 9.0, a process is only considered
+	to be lingering in the code if it has direct references to the code.
+	For more information see documentation of
+	<seealso marker="erts:erlang#check_process_code/3"><c>erlang:check_process_code/3</c></seealso>,
+	which is used in order to determine this.</p></note>
         <p>Returns <c>true</c> if successful and any process is needed to
           be killed, otherwise <c>false</c>.</p>
       </desc>
@@ -661,6 +666,11 @@ ok = code:finish_loading(Prepared),
       <desc>
         <p>Purges the code for <c><anno>Module</anno></c>, that is, removes code
           marked as old, but only if no processes linger in it.</p>
+	<note><p>As of ERTS version 9.0, a process is only considered
+	to be lingering in the code if it has direct references to the code.
+	For more information see documentation of
+	<seealso marker="erts:erlang#check_process_code/3"><c>erlang:check_process_code/3</c></seealso>,
+	which is used in order to determine this.</p></note>
         <p>Returns <c>false</c> if the module cannot be purged because
           of processes lingering in old code, otherwise <c>true</c>.</p>
       </desc>
diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl
index b4c9264b30..90e113c178 100644
--- a/lib/tools/test/cover_SUITE.erl
+++ b/lib/tools/test/cover_SUITE.erl
@@ -1001,41 +1001,40 @@ otp_6115(Config) when is_list(Config) ->
     %% Cover compile f1, but not f2
     {ok, f1} = cover:compile(f1),
 
+    %% This test used to ensure that a process containing a
+    %% fun refering to cover compiled code was killed.
+    %% check_process_code may however ignore funs as of ERTS
+    %% version 8.1. The test has therefore been rewritten to
+    %% check that a process with a direct reference (in this
+    %% case a return address) to the code is killed.
+    %% 
     %% If f1 is cover compiled, a process P is started with a
-    %% reference to the fun created in start_fail/0, and cover:stop() is
-    %% called, then P should be killed.
-    %% This is because (the fun held by P) references the cover
+    %% direct reference to the f1, and cover:stop() is called,
+    %% then P should be killed.
+    %% This is because of the return address to the cover
     %% compiled code which should be *unloaded* when cover:stop() is
     %% called -- running cover compiled code when there is no cover
     %% server and thus no ets tables to bump counters in, makes no
     %% sense.
-    Pid1 = f1:start_a(),
-    Pid2 = f1:start_b(),
+    Pid = spawn(fun () -> f1:non_tail_call_f2_wait() end),
 
     %% Now stop cover
     cover:stop(),
 
     %% Ensure that f1 is loaded (and not cover compiled), and that
-    %% both Pid1 and Pid2 are dead.
+    %% both Pid is dead.
     case code:which(f1) of
         Beam when is_list(Beam) ->
             ok;
         Other ->
             ct:fail({"f1 is not reloaded", Other})
     end,
-    case process_info(Pid1) of
+    case process_info(Pid) of
         undefined ->
             ok;
-        _PI1 ->
-            RefToOldP1 = erlang:check_process_code(Pid1, f1),
-            ct:fail({"Pid1 still alive", RefToOldP1})
-    end,
-    case process_info(Pid2) of
-        undefined ->
-            ok;
-        _PI2 ->
-            RefToOldP2 = erlang:check_process_code(Pid1, f2),
-            ct:fail({"Pid2 still alive", RefToOldP2})
+        _PI ->
+            RefToOldP = erlang:check_process_code(Pid, f1),
+            ct:fail({"Pid still alive", RefToOldP})
     end,
 
     file:set_cwd(CWD),
diff --git a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl
index 5399b33f19..fc4a62e70e 100644
--- a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl
+++ b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl
@@ -1,13 +1,6 @@
 -module(f1).
--export([start_a/0, start_b/0]).
+-export([non_tail_call_f2_wait/0]).
 
-start_a() ->
-    f2:start(fun() -> 
-		     ok
-	     end).
-
-start_b() ->
-    f2:start(fun fun1/0).
-
-fun1() ->
-    ok.
+non_tail_call_f2_wait() ->
+    f2:wait(),
+    im_back.
diff --git a/lib/tools/test/cover_SUITE_data/otp_6115/f2.erl b/lib/tools/test/cover_SUITE_data/otp_6115/f2.erl
index 72a6a64c4d..4bc88035c7 100644
--- a/lib/tools/test/cover_SUITE_data/otp_6115/f2.erl
+++ b/lib/tools/test/cover_SUITE_data/otp_6115/f2.erl
@@ -1,13 +1,5 @@
 -module(f2).
--export([start/1]).
+-export([wait/0]).
 
-start(Fun) ->
-    spawn(fun() ->
-		  wait(Fun)
-	  end).
-
-wait(Fun) ->
-    receive
-	go ->
-	    Fun()
-    end.
+wait() ->
+    receive after infinity -> ok end.
-- 
cgit v1.2.3