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