aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/emulator/beam/atom.names1
-rw-r--r--erts/emulator/beam/beam_bif_load.c73
-rw-r--r--erts/emulator/beam/beam_load.c17
-rw-r--r--erts/emulator/beam/beam_ranges.c152
-rw-r--r--erts/emulator/beam/bif.tab1
-rw-r--r--erts/emulator/beam/code_ix.c4
-rw-r--r--erts/emulator/beam/code_ix.h2
-rw-r--r--erts/emulator/beam/global.h3
-rw-r--r--erts/emulator/beam/module.h1
-rw-r--r--erts/emulator/test/Makefile1
-rw-r--r--erts/emulator/test/multi_load_SUITE.erl196
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin49836 -> 55528 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin101968 -> 102148 bytes
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl133
-rw-r--r--erts/preloaded/src/erlang.erl10
-rw-r--r--lib/kernel/doc/src/code.xml136
-rw-r--r--lib/kernel/src/code.erl317
-rw-r--r--lib/kernel/src/code_server.erl111
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl12
-rw-r--r--lib/kernel/test/Makefile3
-rw-r--r--lib/kernel/test/code_SUITE.erl4
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE.erl37
-rw-r--r--lib/kernel/test/multi_load_SUITE.erl412
-rw-r--r--lib/tools/emacs/erlang.el1
24 files changed, 1480 insertions, 147 deletions
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 2777c3d112..dca8b503bf 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -211,6 +211,7 @@ atom dsend
atom dsend_continue_trap
atom dunlink
atom duplicate_bag
+atom duplicated
atom dupnames
atom einval
atom elib_malloc
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 1b4c022370..0b47fc3586 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -86,7 +86,7 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
ASSERT(modp->curr.num_breakpoints == 0);
}
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(1);
res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
@@ -139,6 +139,25 @@ prepare_loading_2(BIF_ALIST_2)
BIF_RET(res);
}
+BIF_RETTYPE
+has_prepared_code_on_load_1(BIF_ALIST_1)
+{
+ Eterm res;
+ ProcBin* pb;
+
+ if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) {
+ error:
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ pb = (ProcBin*) binary_val(BIF_ARG_1);
+ res = erts_has_code_on_load(pb->val);
+ if (res == NIL) {
+ goto error;
+ }
+ BIF_RET(res);
+}
+
struct m {
Binary* code;
Eterm module;
@@ -163,14 +182,13 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions)
Eterm* hp = HAlloc(p, 3 + 2*exceptions);
Eterm res = NIL;
- mp += exceptions - 1;
while (exceptions > 0) {
if (mp->exception) {
res = CONS(hp, mp->module, res);
hp += 2;
exceptions--;
}
- mp--;
+ mp++;
}
return TUPLE2(hp, tag, res);
}
@@ -202,8 +220,12 @@ finish_loading_1(BIF_ALIST_1)
n = erts_list_length(BIF_ARG_1);
if (n < 0) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ badarg:
+ if (p) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, p);
+ }
+ erts_release_code_write_permission();
+ BIF_ERROR(BIF_P, BADARG);
}
p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m));
@@ -218,29 +240,32 @@ finish_loading_1(BIF_ALIST_1)
ProcBin* pb;
if (!ERTS_TERM_IS_MAGIC_BINARY(term)) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ goto badarg;
}
pb = (ProcBin*) binary_val(term);
p[i].code = pb->val;
p[i].module = erts_module_for_prepared_code(p[i].code);
if (p[i].module == NIL) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ goto badarg;
}
BIF_ARG_1 = CDR(cons);
}
/*
* Since we cannot handle atomic loading of a group of modules
- * if one or more of them uses on_load, we will only allow one
- * element in the list. This limitation is intended to be
- * lifted in the future.
+ * if one or more of them uses on_load, we will only allow
+ * more than one element in the list if none of the modules
+ * have an on_load function.
*/
if (n > 1) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT);
- goto done;
+ for (i = 0; i < n; i++) {
+ if (erts_has_code_on_load(p[i].code) == am_true) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, p);
+ erts_release_code_write_permission();
+ BIF_ERROR(BIF_P, SYSTEM_LIMIT);
+ }
+ }
}
/*
@@ -252,11 +277,27 @@ finish_loading_1(BIF_ALIST_1)
*/
res = am_ok;
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(n);
for (i = 0; i < n; i++) {
p[i].modp = erts_put_module(p[i].module);
+ p[i].modp->seen = 0;
}
+
+ exceptions = 0;
+ for (i = 0; i < n; i++) {
+ p[i].exception = 0;
+ if (p[i].modp->seen) {
+ p[i].exception = 1;
+ exceptions++;
+ }
+ p[i].modp->seen = 1;
+ }
+ if (exceptions) {
+ res = exception_list(BIF_P, am_duplicated, p, exceptions);
+ goto done;
+ }
+
for (i = 0; i < n; i++) {
if (p[i].modp->curr.num_breakpoints > 0 ||
p[i].modp->curr.num_traced_exports > 0 ||
@@ -492,7 +533,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
}
{
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(0);
code_ix = erts_staging_code_ix();
modp = erts_get_module(BIF_ARG_1, code_ix);
if (!modp) {
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 1511a4f935..f115df935f 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -888,6 +888,23 @@ erts_module_for_prepared_code(Binary* magic)
}
}
+/*
+ * Return a non-zero value if the module has an on_load function,
+ * or 0 if it does not.
+ */
+
+Eterm
+erts_has_code_on_load(Binary* magic)
+{
+ LoaderState* stp;
+
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != loader_state_dtor) {
+ return NIL;
+ }
+ stp = ERTS_MAGIC_BIN_DATA(magic);
+ return stp->on_load ? am_true : am_false;
+}
+
static void
free_loader_state(Binary* magic)
{
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index 5a2b66727a..54c337ee72 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -53,6 +53,7 @@ struct ranges {
};
static struct ranges r[ERTS_NUM_CODE_IX];
static erts_smp_atomic_t mem_used;
+static Range* write_ptr;
#ifdef HARD_DEBUG
static void check_consistency(struct ranges* p)
@@ -72,6 +73,17 @@ static void check_consistency(struct ranges* p)
# define CHECK(r)
#endif /* HARD_DEBUG */
+static int
+rangecompare(Range* a, Range* b)
+{
+ if (a->start < b->start) {
+ return -1;
+ } else if (a->start == b->start) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
void
erts_init_ranges(void)
@@ -88,45 +100,70 @@ erts_init_ranges(void)
}
void
-erts_start_staging_ranges(void)
+erts_start_staging_ranges(int num_new)
{
+ ErtsCodeIndex src = erts_active_code_ix();
ErtsCodeIndex dst = erts_staging_code_ix();
+ Sint need;
if (r[dst].modules) {
erts_smp_atomic_add_nob(&mem_used, -r[dst].allocated);
erts_free(ERTS_ALC_T_MODULE_REFS, r[dst].modules);
- r[dst].modules = NULL;
}
+
+ need = r[dst].allocated = r[src].n + num_new;
+ erts_smp_atomic_add_nob(&mem_used, need);
+ write_ptr = erts_alloc(ERTS_ALC_T_MODULE_REFS,
+ need * sizeof(Range));
+ r[dst].modules = write_ptr;
}
void
erts_end_staging_ranges(int commit)
{
- ErtsCodeIndex dst = erts_staging_code_ix();
-
- if (commit && r[dst].modules == NULL) {
+ if (commit) {
Sint i;
- Sint n;
-
- /* No modules added, just clone src and remove purged code. */
ErtsCodeIndex src = erts_active_code_ix();
+ ErtsCodeIndex dst = erts_staging_code_ix();
+ Range* mp;
+ Sint num_inserted;
- erts_smp_atomic_add_nob(&mem_used, r[src].n);
- r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS,
- r[src].n * sizeof(Range));
- r[dst].allocated = r[src].n;
- n = 0;
+ mp = r[dst].modules;
+ num_inserted = write_ptr - mp;
for (i = 0; i < r[src].n; i++) {
Range* rp = r[src].modules+i;
if (rp->start < RANGE_END(rp)) {
/* Only insert a module that has not been purged. */
- r[dst].modules[n] = *rp;
- n++;
+ write_ptr->start = rp->start;
+ erts_smp_atomic_init_nob(&write_ptr->end,
+ (erts_aint_t)(RANGE_END(rp)));
+ write_ptr++;
+ }
+ }
+
+ /*
+ * There are num_inserted new range entries (unsorted) at the
+ * beginning of the modules array, followed by the old entries
+ * (sorted). We must now sort the entire array.
+ */
+
+ r[dst].n = write_ptr - mp;
+ if (num_inserted > 1) {
+ qsort(mp, r[dst].n, sizeof(Range),
+ (int (*)(const void *, const void *)) rangecompare);
+ } else if (num_inserted == 1) {
+ /* Sift the new range into place. This is faster than qsort(). */
+ Range t = mp[0];
+ for (i = 0; i < r[dst].n-1 && t.start > mp[i+1].start; i++) {
+ mp[i] = mp[i+1];
}
+ mp[i] = t;
}
- r[dst].n = n;
+ r[dst].modules = mp;
+ CHECK(&r[dst]);
erts_smp_atomic_set_nob(&r[dst].mid,
- (erts_aint_t) (r[dst].modules + n / 2));
+ (erts_aint_t) (r[dst].modules +
+ r[dst].n / 2));
}
}
@@ -135,82 +172,29 @@ erts_update_ranges(BeamInstr* code, Uint size)
{
ErtsCodeIndex dst = erts_staging_code_ix();
ErtsCodeIndex src = erts_active_code_ix();
- Sint i;
- Sint n;
- Sint need;
if (src == dst) {
ASSERT(!erts_initialized);
/*
- * During start-up of system, the indices are the same.
- * Handle this by faking a source area.
+ * During start-up of system, the indices are the same
+ * and erts_start_staging_ranges() has not been called.
*/
- src = (src+1) % ERTS_NUM_CODE_IX;
- if (r[src].modules) {
- erts_smp_atomic_add_nob(&mem_used, -r[src].allocated);
- erts_free(ERTS_ALC_T_MODULE_REFS, r[src].modules);
+ if (r[dst].modules == NULL) {
+ Sint need = 128;
+ erts_smp_atomic_add_nob(&mem_used, need);
+ r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS,
+ need * sizeof(Range));
+ r[dst].allocated = need;
+ write_ptr = r[dst].modules;
}
- r[src] = r[dst];
- r[dst].modules = 0;
}
- CHECK(&r[src]);
-
- ASSERT(r[dst].modules == NULL);
- need = r[dst].allocated = r[src].n + 1;
- erts_smp_atomic_add_nob(&mem_used, need);
- r[dst].modules = (Range *) erts_alloc(ERTS_ALC_T_MODULE_REFS,
- need * sizeof(Range));
- n = 0;
- for (i = 0; i < r[src].n; i++) {
- Range* rp = r[src].modules+i;
- if (code < rp->start) {
- r[dst].modules[n].start = code;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(((byte *)code) + size));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code);
- n++;
- break;
- }
- if (rp->start < RANGE_END(rp)) {
- /* Only insert a module that has not been purged. */
- r[dst].modules[n].start = rp->start;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(RANGE_END(rp)));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start);
- n++;
- }
- }
-
- while (i < r[src].n) {
- Range* rp = r[src].modules+i;
- if (rp->start < RANGE_END(rp)) {
- /* Only insert a module that has not been purged. */
- r[dst].modules[n].start = rp->start;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(RANGE_END(rp)));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start);
- n++;
- }
- i++;
- }
-
- if (n == 0 || code > r[dst].modules[n-1].start) {
- r[dst].modules[n].start = code;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(((byte *)code) + size));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code);
- n++;
- }
-
- ASSERT(n <= r[src].n+1);
- r[dst].n = n;
- erts_smp_atomic_set_nob(&r[dst].mid,
- (erts_aint_t) (r[dst].modules + n / 2));
-
- CHECK(&r[dst]);
- CHECK(&r[src]);
+ ASSERT(r[dst].modules);
+ write_ptr->start = code;
+ erts_smp_atomic_init_nob(&(write_ptr->end),
+ (erts_aint_t)(((byte *)code) + size));
+ write_ptr++;
}
void
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 77d3d95673..a6670c10e8 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -651,6 +651,7 @@ bif binary:split/2
bif binary:split/3
bif erts_debug:size_shared/1
bif erts_debug:copy_shared/1
+bif erlang:has_prepared_code_on_load/1
#
# Obsolete
diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c
index 209d008d18..1b0968c55c 100644
--- a/erts/emulator/beam/code_ix.c
+++ b/erts/emulator/beam/code_ix.c
@@ -65,12 +65,12 @@ void erts_code_ix_init(void)
CIX_TRACE("init");
}
-void erts_start_staging_code_ix(void)
+void erts_start_staging_code_ix(int num_new)
{
beam_catches_start_staging();
export_start_staging();
module_start_staging();
- erts_start_staging_ranges();
+ erts_start_staging_ranges(num_new);
CIX_TRACE("start");
}
diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h
index 5f00b409ef..7a66211a5b 100644
--- a/erts/emulator/beam/code_ix.h
+++ b/erts/emulator/beam/code_ix.h
@@ -100,7 +100,7 @@ void erts_release_code_write_permission(void);
* Must be followed by calls to either "end" and "commit" or "abort" before
* code write permission can be released.
*/
-void erts_start_staging_code_ix(void);
+void erts_start_staging_code_ix(int num_new);
/* End the staging.
* Preceded by "start" and must be followed by "commit".
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 2a8bdb6ee3..956efa5e36 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1008,6 +1008,7 @@ typedef struct {
Binary* erts_alloc_loader_state(void);
Eterm erts_module_for_prepared_code(Binary* magic);
+Eterm erts_has_code_on_load(Binary* magic);
Eterm erts_prepare_loading(Binary* loader_state, Process *c_p,
Eterm group_leader, Eterm* modp,
byte* code, Uint size);
@@ -1026,7 +1027,7 @@ Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info);
/* beam_ranges.c */
void erts_init_ranges(void);
-void erts_start_staging_ranges(void);
+void erts_start_staging_ranges(int num_new);
void erts_end_staging_ranges(int commit);
void erts_update_ranges(BeamInstr* code, Uint size);
void erts_remove_from_ranges(BeamInstr* code);
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index e66d628ca9..b7468b0926 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -37,6 +37,7 @@ struct erl_module_instance {
typedef struct erl_module {
IndexSlot slot; /* Must be located at top of struct! */
int module; /* Atom index for module (not tagged). */
+ int seen; /* Used by finish_loading() */
struct erl_module_instance curr;
struct erl_module_instance old; /* protected by "old_code" rwlock */
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 987a655c3d..318db4b45e 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -74,6 +74,7 @@ MODULES= \
match_spec_SUITE \
module_info_SUITE \
monitor_SUITE \
+ multi_load_SUITE \
nested_SUITE \
nif_SUITE \
node_container_SUITE \
diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl
new file mode 100644
index 0000000000..784b239116
--- /dev/null
+++ b/erts/emulator/test/multi_load_SUITE.erl
@@ -0,0 +1,196 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2012. 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(multi_load_SUITE).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ many/1,on_load/1,errors/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [many,on_load,errors].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+many(_Config) ->
+ Ms = make_modules(100, fun many_module/1),
+
+ io:put_chars("Light load\n"
+ "=========="),
+ many_measure(Ms),
+
+ _ = [spawn_link(fun many_worker/0) || _ <- lists:seq(1, 8)],
+ erlang:yield(),
+ io:put_chars("Heavy load\n"
+ "=========="),
+ many_measure(Ms),
+
+ ok.
+
+many_module(M) ->
+ ["-module("++M++").",
+ "-compile(export_all).",
+ "f1() -> ok.",
+ "f2() -> ok.",
+ "f3() -> ok.",
+ "f4() -> ok."].
+
+many_measure(Ms) ->
+ many_purge(Ms),
+ MsPrep1 = prepare_modules(Ms),
+ Us1 = ms(fun() -> many_load_seq(MsPrep1) end),
+ many_try_call(Ms),
+ many_purge(Ms),
+ MsPrep2 = prepare_modules(Ms),
+ Us2 = ms(fun() -> many_load_par(MsPrep2) end),
+ many_try_call(Ms),
+ io:format("# modules: ~9w\n"
+ "Sequential: ~9w µs\n"
+ "Parallel: ~9w µs\n"
+ "Ratio: ~9w\n",
+ [length(Ms),Us1,Us2,round(Us1/Us2)]),
+ ok.
+
+many_load_seq(Ms) ->
+ [erlang:finish_loading([M]) || M <- Ms],
+ ok.
+
+many_load_par(Ms) ->
+ erlang:finish_loading(Ms).
+
+many_purge(Ms) ->
+ _ = [catch erlang:purge_module(M) || {M,_} <- Ms],
+ ok.
+
+many_try_call(Ms) ->
+ _ = [begin
+ ok = M:f1(),
+ ok = M:f2(),
+ ok = M:f3(),
+ ok = M:f4()
+ end || {M,_} <- Ms],
+ ok.
+
+many_worker() ->
+ many_worker(lists:seq(1, 100)).
+
+many_worker(L) ->
+ N0 = length(L),
+ N1 = N0 * N0 * N0,
+ N2 = N1 div (N0 * N0),
+ N3 = N2 + 10,
+ _ = N3 - 10,
+ many_worker(L).
+
+
+on_load(_Config) ->
+ On = make_modules(2, fun on_load_module/1),
+ OnPrep = prepare_modules(On),
+ {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(OnPrep)),
+
+ Normal = make_modules(1, fun on_load_normal/1),
+ Mixed = Normal ++ tl(On),
+ MixedPrep = prepare_modules(Mixed),
+ {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(MixedPrep)),
+
+ [false,true] = [erlang:has_prepared_code_on_load(Code) ||
+ Code <- MixedPrep],
+ {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(<<1,2,3>>)),
+ Magic = ets:match_spec_compile([{'_',[true],['$_']}]),
+ {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(Magic)),
+
+ SingleOnPrep = tl(OnPrep),
+ {on_load,[OnLoadMod]} = erlang:finish_loading(SingleOnPrep),
+ ok = erlang:call_on_load_function(OnLoadMod),
+
+ ok.
+
+on_load_module(M) ->
+ ["-module("++M++").",
+ "-on_load(f/0).",
+ "f() -> ok."].
+
+on_load_normal(M) ->
+ ["-module("++M++")."].
+
+
+errors(_Config) ->
+ finish_loading_badarg(x),
+ finish_loading_badarg([x|y]),
+ finish_loading_badarg([x]),
+ finish_loading_badarg([<<>>]),
+
+ Mods = make_modules(2, fun errors_module/1),
+ Ms = lists:sort([M || {M,_} <- Mods]),
+ Prep = prepare_modules(Mods),
+ {duplicated,Dups} = erlang:finish_loading(Prep ++ Prep),
+ Ms = lists:sort(Dups),
+ ok.
+
+finish_loading_badarg(Arg) ->
+ {'EXIT',{badarg,[{erlang,finish_loading,[Arg],_}|_]}} =
+ (catch erlang:finish_loading(Arg)).
+
+errors_module(M) ->
+ ["-module("++M++").",
+ "-export([f/0]).",
+ "f() -> ok."].
+
+%%%
+%%% Common utilities
+%%%
+
+ms(Fun) ->
+ {Ms,ok} = timer:tc(Fun),
+ Ms.
+
+make_modules(0, _) ->
+ [];
+make_modules(N, Fun) ->
+ U = erlang:unique_integer([positive]),
+ M0 = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U),
+ Contents = Fun(M0),
+ Forms = [make_form(S) || S <- Contents],
+ {ok,M,Code} = compile:forms(Forms),
+ [{M,Code}|make_modules(N-1, Fun)].
+
+make_form(S) ->
+ {ok,Toks,_} = erl_scan:string(S),
+ {ok,Form} = erl_parse:parse_form(Toks),
+ Form.
+
+prepare_modules(Ms) ->
+ [erlang:prepare_loading(M, Code) || {M,Code} <- Ms].
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index ca9e6bd20f..6d777fa811 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index b353129a34..db17c53ff3 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 824ed3435d..cbcced5512 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -55,6 +55,9 @@
%% Used by test suites
-export([purge_archive_cache/0]).
+%% Used by init and the code server.
+-export([get_modules/3]).
+
-include_lib("kernel/include/file.hrl").
-type host() :: atom().
@@ -236,6 +239,16 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun)
purge_archive_cache() ->
request(purge_archive_cache).
+
+-spec get_modules([module()],
+ fun((atom(), string(), binary()) ->
+ {'ok',any()} | {'error',any()}),
+ [string()]) ->
+ {'ok',{[any()],[any()]}}.
+
+get_modules(Modules, Fun, Path) ->
+ request({get_modules,{Modules,Fun,Path}}).
+
request(Req) ->
Loader = whereis(erl_prim_loader),
Loader ! {self(),Req},
@@ -325,6 +338,8 @@ handle_request(Req, Paths, St0) ->
{{ok,Paths},St0};
{get_file,File} ->
handle_get_file(St0, Paths, File);
+ {get_modules,{Modules,Fun,ModPaths}} ->
+ handle_get_modules(St0, Modules, Fun, ModPaths);
{list_dir,Dir} ->
handle_list_dir(St0, Dir);
{read_file_info,File} ->
@@ -465,6 +480,124 @@ efile_timeout_handler(State, _Parent) ->
State.
%%% --------------------------------------------------------
+%%% Read and process severals modules in parallel.
+%%% --------------------------------------------------------
+
+handle_get_modules(#state{loader=efile}=St, Ms, Process, Paths) ->
+ Primary = (St#state.prim_state)#prim_state.primary_archive,
+ Res = case efile_any_archives(Paths, Primary) of
+ false ->
+ efile_get_mods_par(Ms, Process, Paths);
+ true ->
+ Get = fun efile_get_file_from_port/3,
+ gm_get_mods(St, Get, Ms, Process, Paths)
+ end,
+ {Res,St};
+handle_get_modules(#state{loader=inet}=St, Ms, Process, Paths) ->
+ Get = fun inet_get_file_from_port/3,
+ {gm_get_mods(St, Get, Ms, Process, Paths),St}.
+
+efile_get_mods_par(Ms, Process, Paths) ->
+ Self = self(),
+ Ref = make_ref(),
+ GmSpawn = fun() ->
+ efile_gm_spawn({Self,Ref}, Ms, Process, Paths)
+ end,
+ _ = spawn_link(GmSpawn),
+ N = length(Ms),
+ efile_gm_recv(N, Ref, [], []).
+
+efile_any_archives([H|T], Primary) ->
+ case name_split(Primary, H) of
+ {file,_} -> efile_any_archives(T, Primary);
+ {archive,_,_} -> true
+ end;
+efile_any_archives([], _) ->
+ false.
+
+efile_gm_recv(0, _Ref, Succ, Fail) ->
+ {ok,{Succ,Fail}};
+efile_gm_recv(N, Ref, Succ, Fail) ->
+ receive
+ {Ref,Mod,{ok,Res}} ->
+ efile_gm_recv(N-1, Ref, [{Mod,Res}|Succ], Fail);
+ {Ref,Mod,{error,Res}} ->
+ efile_gm_recv(N-1, Ref, Succ, [{Mod,Res}|Fail])
+ end.
+
+efile_gm_spawn(ParentRef, Ms, Process, Paths) ->
+ efile_gm_spawn_1(0, Ms, ParentRef, Process, Paths).
+
+efile_gm_spawn_1(N, Ms, ParentRef, Process, Paths) when N >= 32 ->
+ receive
+ {'DOWN',_,process,_,_} ->
+ efile_gm_spawn_1(N-1, Ms, ParentRef, Process, Paths)
+ end;
+efile_gm_spawn_1(N, [M|Ms], ParentRef, Process, Paths) ->
+ Get = fun() -> efile_gm_get(Paths, M, ParentRef, Process) end,
+ _ = spawn_monitor(Get),
+ efile_gm_spawn_1(N+1, Ms, ParentRef, Process, Paths);
+efile_gm_spawn_1(_, [], _, _, _) ->
+ ok.
+
+efile_gm_get(Paths, Mod, ParentRef, Process) ->
+ File = atom_to_list(Mod) ++ init:objfile_extension(),
+ efile_gm_get_1(Paths, File, Mod, ParentRef, Process).
+
+efile_gm_get_1([P|Ps], File0, Mod, {Parent,Ref}=PR, Process) ->
+ File = join(P, File0),
+ Res = try prim_file:read_file(File) of
+ {ok,Bin} ->
+ gm_process(Mod, File, Bin, Process);
+ {error,enoent} ->
+ efile_gm_get_1(Ps, File0, Mod, PR, Process);
+ Error ->
+ check_file_result(get_modules, File, Error),
+ Error
+ catch
+ _:Reason ->
+ {error,{crash,Reason}}
+ end,
+ Parent ! {Ref,Mod,Res};
+efile_gm_get_1([], _, Mod, {Parent,Ref}, _Process) ->
+ Parent ! {Ref,Mod,{error,enoent}}.
+
+gm_get_mods(St, Get, Ms, Process, Paths) ->
+ gm_get_mods(St, Get, Ms, Process, Paths, [], []).
+
+gm_get_mods(St, Get, [M|Ms], Process, Paths, Succ, Fail) ->
+ File = atom_to_list(M) ++ init:objfile_extension(),
+ case gm_arch_get(St, Get, M, File, Paths, Process) of
+ {ok,Res} ->
+ gm_get_mods(St, Get, Ms, Process, Paths,
+ [{M,Res}|Succ], Fail);
+ {error,Res} ->
+ gm_get_mods(St, Get, Ms, Process, Paths,
+ Succ, [{M,Res}|Fail])
+ end;
+gm_get_mods(_St, _Get, [], _, _, Succ, Fail) ->
+ {ok,{Succ,Fail}}.
+
+gm_arch_get(St, Get, Mod, File, Paths, Process) ->
+ case Get(St, File, Paths) of
+ {{error,_}=E,_} ->
+ E;
+ {{ok,Bin,Full},_} ->
+ gm_process(Mod, Full, Bin, Process)
+ end.
+
+gm_process(Mod, File, Bin, Process) ->
+ try Process(Mod, File, Bin) of
+ {ok,_}=Res -> Res;
+ {error,_}=Res -> Res;
+ Other -> {error,{bad_return,Other}}
+ catch
+ _:Error ->
+ {error,{crash,Error}}
+ end.
+
+
+%%% --------------------------------------------------------
%%% Functions which handle inet prim_loader
%%% --------------------------------------------------------
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index ab51cf385c..9bf8d13fde 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -105,7 +105,9 @@
-export([garbage_collect/0, garbage_collect/1, garbage_collect/2]).
-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]).
-export([get_module_info/1, get_stacktrace/0, group_leader/0]).
--export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]).
+-export([group_leader/2]).
+-export([halt/0, halt/1, halt/2, hash/2,
+ has_prepared_code_on_load/1, hibernate/3]).
-export([insert_element/3]).
-export([integer_to_binary/1, integer_to_list/1]).
-export([iolist_size/1, iolist_to_binary/1]).
@@ -997,6 +999,12 @@ halt(_Status, _Options) ->
hash(_Term, _Range) ->
erlang:nif_error(undefined).
+%% has_prepared_code_on_load/1
+-spec erlang:has_prepared_code_on_load(PreparedCode) -> boolean() when
+ PreparedCode :: binary().
+has_prepared_code_on_load(_PreparedCode) ->
+ erlang:nif_error(undefined).
+
%% hibernate/3
-spec erlang:hibernate(Module, Function, Args) -> no_return() when
Module :: module(),
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index d4c9a48901..819da544c3 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -310,6 +310,10 @@
<datatype>
<name name="load_error_rsn"/>
</datatype>
+ <datatype>
+ <name name="prepared_code"/>
+ <desc>An opaque term holding prepared code.</desc>
+ </datatype>
</datatypes>
<funcs>
@@ -479,6 +483,138 @@
</desc>
</func>
<func>
+ <name name="atomic_load" arity="1"/>
+ <fsummary>Load a list of modules atomically</fsummary>
+ <desc>
+ <p>Tries to load all of the modules in the list
+ <c><anno>Modules</anno></c> atomically. That means that
+ either all modules are loaded at the same time, or
+ none of the modules are loaded if there is a problem with any
+ of the modules.</p>
+ <p>Loading can fail for one the following reasons:</p>
+ <taglist>
+ <tag><c>badfile</c></tag>
+ <item>
+ <p>The object code has an incorrect format or the module
+ name in the object code is not the expected module name.</p>
+ </item>
+ <tag><c>nofile</c></tag>
+ <item>
+ <p>No file with object code exists.</p>
+ </item>
+ <tag><c>on_load_not_allowed</c></tag>
+ <item>
+ <p>A module contains an
+ <seealso marker="doc/reference_manual:code_loading#on_load">-on_load function</seealso>.</p>
+ </item>
+ <tag><c>duplicated</c></tag>
+ <item>
+ <p>A module is included more than once in
+ <c><anno>Modules</anno></c>.</p>
+ </item>
+ <tag><c>not_purged</c></tag>
+ <item>
+ <p>The object code can not be loaded because an old version
+ of the code already exists.</p>
+ </item>
+ <tag><c>sticky_directory</c></tag>
+ <item>
+ <p>The object code resides in a sticky directory.</p>
+ </item>
+ <tag><c>pending_on_load</c></tag>
+ <item>
+ <p>A previously loaded module contains an
+ <c>-on_load</c> function that never finished.</p>
+ </item>
+ </taglist>
+ <p>If it is important to minimize the time that an application
+ is inactive while changing code, use
+ <seealso marker="#prepare_loading/1">prepare_loading/1</seealso>
+ and
+ <seealso marker="#finish_loading/1">finish_loading/1</seealso>
+ instead of <c>atomic_load/1</c>. Here is an example:</p>
+<pre>
+{ok,Prepared} = code:prepare_loading(Modules),
+%% Put the application into an inactive state or do any
+%% other preparation needed before changing the code.
+ok = code:finish_loading(Prepared),
+%% Resume the application.</pre>
+ </desc>
+ </func>
+ <func>
+ <name name="prepare_loading" arity="1"/>
+ <fsummary>Prepare a list of modules atomically</fsummary>
+ <desc>
+ <p>Prepares to load the modules in the list
+ <c><anno>Modules</anno></c>.
+ Finish the loading by calling
+ <seealso marker="#finish_loading/1">finish_loading(Prepared)</seealso>.</p>
+ <p>This function can fail with one of the following error reasons:</p>
+ <taglist>
+ <tag><c>badfile</c></tag>
+ <item>
+ <p>The object code has an incorrect format or the module
+ name in the object code is not the expected module name.</p>
+ </item>
+ <tag><c>nofile</c></tag>
+ <item>
+ <p>No file with object code exists.</p>
+ </item>
+ <tag><c>on_load_not_allowed</c></tag>
+ <item>
+ <p>A module contains an
+ <seealso marker="doc/reference_manual:code_loading#on_load">-on_load function</seealso>.</p>
+ </item>
+ <tag><c>duplicated</c></tag>
+ <item>
+ <p>A module is included more than once in
+ <c><anno>Modules</anno></c>.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name name="finish_loading" arity="1"/>
+ <fsummary>Finish loading a list of prepared modules atomically</fsummary>
+ <desc>
+ <p>Tries to load code for all modules that have been previously
+ prepared by
+ <seealso marker="#prepare_loading/1">prepare_loading/1</seealso>.
+ The loading occurs atomically, meaning that
+ either all modules are loaded at the same time, or
+ none of the modules are loaded.</p>
+ <p>This function can fail with one of the following error reasons:</p>
+ <taglist>
+ <tag><c>not_purged</c></tag>
+ <item>
+ <p>The object code can not be loaded because an old version
+ of the code already exists.</p>
+ </item>
+ <tag><c>sticky_directory</c></tag>
+ <item>
+ <p>The object code resides in a sticky directory.</p>
+ </item>
+ <tag><c>pending_on_load</c></tag>
+ <item>
+ <p>A previously loaded module contains an
+ <c>-on_load</c> function that never finished.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name name="ensure_modules_loaded" arity="1"/>
+ <fsummary>Ensure that a list of modules is loaded</fsummary>
+ <desc>
+ <p>Tries to load any modules not already loaded in the list
+ <c><anno>Modules</anno></c> in the same way as
+ <seealso marker="#load_file/1">load_file/1</seealso>.</p>
+ <p>Returns <c>ok</c> if successful, or
+ <c>{error,[{Module,Reason}]}</c> if loading of some modules fails.
+ See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of other possible error reasons.</p>
+ </desc>
+ </func>
+ <func>
<name name="delete" arity="1"/>
<fsummary>Removes current code for a module</fsummary>
<desc>
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 59e226df43..0882cb170c 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -28,11 +28,15 @@
get_path/0,
load_file/1,
ensure_loaded/1,
+ ensure_modules_loaded/1,
load_abs/1,
load_abs/2,
load_binary/3,
load_native_partial/2,
load_native_sticky/3,
+ atomic_load/1,
+ prepare_loading/1,
+ finish_loading/1,
delete/1,
purge/1,
soft_purge/1,
@@ -71,6 +75,7 @@
-deprecated({rehash,0,next_major_release}).
-export_type([load_error_rsn/0, load_ret/0]).
+-export_type([prepared_code/0]).
-include_lib("kernel/include/file.hrl").
@@ -88,6 +93,11 @@
-type loaded_ret_atoms() :: 'cover_compiled' | 'preloaded'.
-type loaded_filename() :: (Filename :: file:filename()) | loaded_ret_atoms().
+-define(PREPARED, '$prepared$').
+-opaque prepared_code() ::
+ {?PREPARED,[{module(),{binary(),string(),_}}]}.
+
+
%%% BIFs
-export([get_chunk/2, is_module_native/1, make_stub_module/3, module_md5/1]).
@@ -303,6 +313,313 @@ rehash() ->
-spec get_mode() -> 'embedded' | 'interactive'.
get_mode() -> call(get_mode).
+%%%
+%%% Loading of several modules in parallel.
+%%%
+
+-spec ensure_modules_loaded([Module]) ->
+ 'ok' | {'error',[{Module,What}]} when
+ Module :: module(),
+ What :: badfile | nofile | on_load_failure.
+
+ensure_modules_loaded(Modules) when is_list(Modules) ->
+ case prepare_ensure(Modules, []) of
+ Ms when is_list(Ms) ->
+ ensure_modules_loaded_1(Ms);
+ error ->
+ error(function_clause, [Modules])
+ end.
+
+ensure_modules_loaded_1(Ms0) ->
+ Ms = lists:usort(Ms0),
+ {Prep,Error0} = load_mods(Ms),
+ {OnLoad,Normal} = partition_on_load(Prep),
+ Error1 = case finish_loading(Normal, true) of
+ ok -> Error0;
+ {error,Err} -> Err ++ Error0
+ end,
+ ensure_modules_loaded_2(OnLoad, Error1).
+
+ensure_modules_loaded_2([{M,_}|Ms], Errors) ->
+ case ensure_loaded(M) of
+ {module,M} ->
+ ensure_modules_loaded_2(Ms, Errors);
+ {error,Err} ->
+ ensure_modules_loaded_2(Ms, [{M,Err}|Errors])
+ end;
+ensure_modules_loaded_2([], []) ->
+ ok;
+ensure_modules_loaded_2([], [_|_]=Errors) ->
+ {error,Errors}.
+
+prepare_ensure([M|Ms], Acc) when is_atom(M) ->
+ case erlang:module_loaded(M) of
+ true ->
+ prepare_ensure(Ms, Acc);
+ false ->
+ prepare_ensure(Ms, [M|Acc])
+ end;
+prepare_ensure([], Acc) ->
+ Acc;
+prepare_ensure(_, _) ->
+ error.
+
+-spec atomic_load(Modules) -> 'ok' | {'error',[{Module,What}]} when
+ Modules :: [Module | {Module, Filename, Binary}],
+ Module :: module(),
+ Filename :: file:filename(),
+ Binary :: binary(),
+ What :: 'badfile' | 'nofile' | 'on_load_not_allowed' | 'duplicated' |
+ 'not_purged' | 'sticky_directory' | 'pending_on_load'.
+
+atomic_load(Modules) ->
+ case do_prepare_loading(Modules) of
+ {ok,Prep} ->
+ finish_loading(Prep, false);
+ {error,_}=Error ->
+ Error;
+ badarg ->
+ error(function_clause, [Modules])
+ end.
+
+-spec prepare_loading(Modules) ->
+ {'ok',Prepared} | {'error',[{Module,What}]} when
+ Modules :: [Module | {Module, Filename, Binary}],
+ Module :: module(),
+ Filename :: file:filename(),
+ Binary :: binary(),
+ Prepared :: prepared_code(),
+ What :: 'badfile' | 'nofile' | 'on_load_not_allowed' | 'duplicated'.
+
+prepare_loading(Modules) ->
+ case do_prepare_loading(Modules) of
+ {ok,Prep} ->
+ {ok,{?PREPARED,Prep}};
+ {error,_}=Error ->
+ Error;
+ badarg ->
+ error(function_clause, [Modules])
+ end.
+
+-spec finish_loading(Prepared) -> 'ok' | {'error',[{Module,What}]} when
+ Prepared :: prepared_code(),
+ Module :: module(),
+ What :: 'not_purged' | 'sticky_directory' | 'pending_on_load'.
+
+finish_loading({?PREPARED,Prepared}=Arg) when is_list(Prepared) ->
+ case verify_prepared(Prepared) of
+ ok ->
+ finish_loading(Prepared, false);
+ error ->
+ error(function_clause, [Arg])
+ end.
+
+partition_load([Item|T], Bs, Ms) ->
+ case Item of
+ {M,File,Bin} when is_atom(M) andalso
+ is_list(File) andalso
+ is_binary(Bin) ->
+ partition_load(T, [Item|Bs], Ms);
+ M when is_atom(M) ->
+ partition_load(T, Bs, [Item|Ms]);
+ _ ->
+ error
+ end;
+partition_load([], Bs, Ms) ->
+ {Bs,Ms}.
+
+do_prepare_loading(Modules) ->
+ case partition_load(Modules, [], []) of
+ {ModBins,Ms} ->
+ case prepare_loading_1(ModBins, Ms) of
+ {error,_}=Error ->
+ Error;
+ Prep when is_list(Prep) ->
+ {ok,Prep}
+ end;
+ error ->
+ badarg
+ end.
+
+prepare_loading_1(ModBins, Ms) ->
+ %% erlang:finish_loading/1 *will* detect duplicates.
+ %% However, we want to detect all errors that can be detected
+ %% by only examining the input data before call the LastAction
+ %% fun.
+ case prepare_check_uniq(ModBins, Ms) of
+ ok ->
+ prepare_loading_2(ModBins, Ms);
+ Error ->
+ Error
+ end.
+
+prepare_loading_2(ModBins, Ms) ->
+ {Prep0,Error0} = load_bins(ModBins),
+ {Prep1,Error1} = load_mods(Ms),
+ case Error0 ++ Error1 of
+ [] ->
+ prepare_loading_3(Prep0 ++ Prep1);
+ [_|_]=Error ->
+ {error,Error}
+ end.
+
+prepare_loading_3(Prep) ->
+ case partition_on_load(Prep) of
+ {[_|_]=OnLoad,_} ->
+ Error = [{M,on_load_not_allowed} || {M,_} <- OnLoad],
+ {error,Error};
+ {[],_} ->
+ Prep
+ end.
+
+prepare_check_uniq([{M,_,_}|T], Ms) ->
+ prepare_check_uniq(T, [M|Ms]);
+prepare_check_uniq([], Ms) ->
+ prepare_check_uniq_1(lists:sort(Ms), []).
+
+prepare_check_uniq_1([M|[M|_]=Ms], Acc) ->
+ prepare_check_uniq_1(Ms, [{M,duplicated}|Acc]);
+prepare_check_uniq_1([_|Ms], Acc) ->
+ prepare_check_uniq_1(Ms, Acc);
+prepare_check_uniq_1([], []) ->
+ ok;
+prepare_check_uniq_1([], [_|_]=Errors) ->
+ {error,Errors}.
+
+partition_on_load(Prep) ->
+ P = fun({_,{Bin,_,_}}) ->
+ erlang:has_prepared_code_on_load(Bin)
+ end,
+ lists:partition(P, Prep).
+
+verify_prepared([{M,{Prep,Name,_Native}}|T])
+ when is_atom(M), is_binary(Prep), is_list(Name) ->
+ try erlang:has_prepared_code_on_load(Prep) of
+ false ->
+ verify_prepared(T);
+ _ ->
+ error
+ catch
+ error:_ ->
+ error
+ end;
+verify_prepared([]) ->
+ ok;
+verify_prepared(_) ->
+ error.
+
+finish_loading(Prepared0, EnsureLoaded) ->
+ Prepared = [{M,{Bin,File}} || {M,{Bin,File,_}} <- Prepared0],
+ Native0 = [{M,Code} || {M,{_,_,Code}} <- Prepared0,
+ Code =/= undefined],
+ case call({finish_loading,Prepared,EnsureLoaded}) of
+ ok ->
+ finish_loading_native(Native0);
+ {error,Errors}=E when EnsureLoaded ->
+ S0 = sofs:relation(Errors),
+ S1 = sofs:domain(S0),
+ R0 = sofs:relation(Native0),
+ R1 = sofs:drestriction(R0, S1),
+ Native = sofs:to_external(R1),
+ finish_loading_native(Native),
+ E;
+ {error,_}=E ->
+ E
+ end.
+
+finish_loading_native([{Mod,Code}|Ms]) ->
+ _ = load_native_partial(Mod, Code),
+ finish_loading_native(Ms);
+finish_loading_native([]) ->
+ ok.
+
+load_mods([]) ->
+ {[],[]};
+load_mods(Mods) ->
+ Path = get_path(),
+ F = prepare_loading_fun(),
+ {ok,{Succ,Error0}} = erl_prim_loader:get_modules(Mods, F, Path),
+ Error = [case E of
+ badfile -> {M,E};
+ _ -> {M,nofile}
+ end || {M,E} <- Error0],
+ {Succ,Error}.
+
+load_bins([]) ->
+ {[],[]};
+load_bins(BinItems) ->
+ F = prepare_loading_fun(),
+ do_par(F, BinItems).
+
+-type prep_fun_type() :: fun((module(), file:filename(), binary()) ->
+ {ok,_} | {error,_}).
+
+-spec prepare_loading_fun() -> prep_fun_type().
+
+prepare_loading_fun() ->
+ GetNative = get_native_fun(),
+ fun(Mod, FullName, Beam) ->
+ case erlang:prepare_loading(Mod, Beam) of
+ Prepared when is_binary(Prepared) ->
+ {ok,{Prepared,FullName,GetNative(Beam)}};
+ {error,_}=Error ->
+ Error
+ end
+ end.
+
+get_native_fun() ->
+ Architecture = erlang:system_info(hipe_architecture),
+ try hipe_unified_loader:chunk_name(Architecture) of
+ ChunkTag ->
+ fun(Beam) -> code:get_chunk(Beam, ChunkTag) end
+ catch _:_ ->
+ fun(_) -> undefined end
+ end.
+
+do_par(Fun, L) ->
+ {_,Ref} = spawn_monitor(do_par_fun(Fun, L)),
+ receive
+ {'DOWN',Ref,process,_,Res} ->
+ Res
+ end.
+
+-spec do_par_fun(prep_fun_type(), list()) -> fun(() -> no_return()).
+
+do_par_fun(Fun, L) ->
+ fun() ->
+ _ = [spawn_monitor(do_par_fun_2(Fun, Item)) ||
+ Item <- L],
+ exit(do_par_recv(length(L), [], []))
+ end.
+
+-spec do_par_fun_2(prep_fun_type(),
+ {module(),file:filename(),binary()}) ->
+ fun(() -> no_return()).
+
+do_par_fun_2(Fun, Item) ->
+ fun() ->
+ {Mod,Filename,Bin} = Item,
+ try Fun(Mod, Filename, Bin) of
+ {ok,Res} ->
+ exit({good,{Mod,Res}});
+ {error,Error} ->
+ exit({bad,{Mod,Error}})
+ catch
+ _:Error ->
+ exit({bad,{Mod,Error}})
+ end
+ end.
+
+do_par_recv(0, Good, Bad) ->
+ {Good,Bad};
+do_par_recv(N, Good, Bad) ->
+ receive
+ {'DOWN',_,process,_,{good,Res}} ->
+ do_par_recv(N-1, [Res|Good], Bad);
+ {'DOWN',_,process,_,{bad,Res}} ->
+ do_par_recv(N-1, Good, [Res|Bad])
+ end.
+
%%-----------------------------------------------------------------
call(Req) ->
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index b52def8777..6262407354 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -28,11 +28,10 @@
]).
-include_lib("kernel/include/file.hrl").
+-include_lib("stdlib/include/ms_transform.hrl").
-import(lists, [foreach/2]).
--define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded).
-
-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}.
-record(state, {supervisor :: pid(),
@@ -90,8 +89,6 @@ init(Ref, Parent, [Root,Mode]) ->
namedb = init_namedb(Path),
mode = Mode},
- put(?ANY_NATIVE_CODE_LOADED, false),
-
Parent ! {Ref,{ok,self()}},
loop(State).
@@ -289,14 +286,14 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) ->
handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
Architecture = erlang:system_info(hipe_architecture),
Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)),
- Status = hipe_result_to_status(Result),
+ Status = hipe_result_to_status(Result, S),
{reply,Status,S};
handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
Architecture = erlang:system_info(hipe_architecture),
Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule,
Architecture)),
- Status = hipe_result_to_status(Result),
+ Status = hipe_result_to_status(Result, S),
{reply,Status,S};
handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) ->
@@ -356,6 +353,9 @@ handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From
handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) ->
{reply, Mode, S};
+handle_call({finish_loading,Prepared,EnsureLoaded}, {_,_}, S) ->
+ {reply,finish_loading(Prepared, EnsureLoaded, S),S};
+
handle_call(Other,{_From,_Tag}, S) ->
error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]),
{noreply,S}.
@@ -1107,8 +1107,7 @@ try_load_module_2(File, Mod, Bin, Caller, Architecture,
#state{moddb=Db}=St) ->
case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of
{module,Mod} = Module ->
- put(?ANY_NATIVE_CODE_LOADED, true),
- ets:insert(Db, {Mod,File}),
+ ets:insert(Db, [{{native,Mod},true},{Mod,File}]),
{reply,Module,St};
no_native ->
try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
@@ -1122,7 +1121,7 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture,
case erlang:load_module(Mod, Bin) of
{module,Mod} = Module ->
ets:insert(Db, {Mod,File}),
- post_beam_load(Mod, Architecture),
+ post_beam_load([Mod], Architecture, St),
{reply,Module,St};
{error,on_load} ->
handle_on_load(Mod, File, Caller, St);
@@ -1131,23 +1130,24 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture,
{reply,Error,St}
end.
-hipe_result_to_status(Result) ->
+hipe_result_to_status(Result, #state{moddb=Db}) ->
case Result of
- {module,_} ->
- put(?ANY_NATIVE_CODE_LOADED, true),
+ {module,Mod} ->
+ ets:insert(Db, [{{native,Mod},true}]),
Result;
_ ->
{error,Result}
end.
-post_beam_load(Mod, Architecture) ->
+post_beam_load(_, undefined, _) ->
+ %% HiPE is disabled.
+ ok;
+post_beam_load(Mods0, _Architecture, #state{moddb=Db}) ->
%% post_beam_load/2 can potentially be very expensive because it
- %% blocks multi-scheduling; thus we want to avoid the call if we
- %% know that it is not needed.
- case get(?ANY_NATIVE_CODE_LOADED) of
- true -> hipe_unified_loader:post_beam_load(Mod, Architecture);
- false -> ok
- end.
+ %% blocks multi-scheduling. Therefore, we only want to call
+ %% it with modules that are known to have native code loaded.
+ Mods = [M || M <- Mods0, ets:member(Db, {native,M})],
+ hipe_unified_loader:post_beam_load(Mods).
int_list([H|T]) when is_integer(H) -> int_list(T);
int_list([_|_]) -> false;
@@ -1221,7 +1221,6 @@ absname_vr([[X, $:]|Name], _, _AbsBase) ->
absname(filename:join(Name), Dcwd).
-
is_loaded(M, Db) ->
case ets:lookup(Db, M) of
[{M,File}] -> {file,File};
@@ -1236,6 +1235,64 @@ do_soft_purge(Mod) ->
erts_code_purger:soft_purge(Mod).
+%%%
+%%% Loading of multiple modules in parallel.
+%%%
+
+finish_loading(Prepared, EnsureLoaded, #state{moddb=Db}=St) ->
+ Ps = [fun(L) -> finish_loading_ensure(L, EnsureLoaded) end,
+ fun(L) -> abort_if_pending_on_load(L, St) end,
+ fun(L) -> abort_if_sticky(L, Db) end,
+ fun(L) -> do_finish_loading(L, St) end],
+ run(Ps, Prepared).
+
+finish_loading_ensure(Prepared, true) ->
+ {ok,[P || {M,_}=P <- Prepared, not erlang:module_loaded(M)]};
+finish_loading_ensure(Prepared, false) ->
+ {ok,Prepared}.
+
+abort_if_pending_on_load(L, #state{on_load=[]}) ->
+ {ok,L};
+abort_if_pending_on_load(L, #state{on_load=OnLoad}) ->
+ Pending = [{M,pending_on_load} ||
+ {M,_} <- L,
+ lists:keymember(M, 2, OnLoad)],
+ case Pending of
+ [] -> {ok,L};
+ [_|_] -> {error,Pending}
+ end.
+
+abort_if_sticky(L, Db) ->
+ Sticky = [{M,sticky_directory} || {M,_} <- L, is_sticky(M, Db)],
+ case Sticky of
+ [] -> {ok,L};
+ [_|_] -> {error,Sticky}
+ end.
+
+do_finish_loading(Prepared, #state{moddb=Db}=St) ->
+ MagicBins = [B || {_,{B,_}} <- Prepared],
+ case erlang:finish_loading(MagicBins) of
+ ok ->
+ MFs = [{M,F} || {M,{_,F}} <- Prepared],
+ true = ets:insert(Db, MFs),
+ Ms = [M || {M,_} <- MFs],
+ Architecture = erlang:system_info(hipe_architecture),
+ post_beam_load(Ms, Architecture, St),
+ ok;
+ {Reason,Ms} ->
+ {error,[{M,Reason} || M <- Ms]}
+ end.
+
+run([F], Data) ->
+ F(Data);
+run([F|Fs], Data0) ->
+ case F(Data0) of
+ {ok,Data} ->
+ run(Fs, Data);
+ {error,_}=Error ->
+ Error
+ end.
+
%% -------------------------------------------------------
%% The on_load functionality.
%% -------------------------------------------------------
@@ -1317,18 +1374,8 @@ finish_on_load_report(Mod, Term) ->
%% -------------------------------------------------------
all_loaded(Db) ->
- all_l(Db, ets:slot(Db, 0), 1, []).
-
-all_l(_Db, '$end_of_table', _, Acc) ->
- Acc;
-all_l(Db, ModInfo, N, Acc) ->
- NewAcc = strip_mod_info(ModInfo,Acc),
- all_l(Db, ets:slot(Db, N), N + 1, NewAcc).
-
-
-strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc);
-strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]);
-strip_mod_info([], Acc) -> Acc.
+ Ms = ets:fun2ms(fun({M,_}=T) when is_atom(M) -> T end),
+ ets:select(Db, Ms).
-spec error_msg(io:format(), [term()]) -> 'ok'.
error_msg(Format, Args) ->
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index ddbbc548dd..73fcb2469c 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -44,7 +44,7 @@
-export([chunk_name/1,
%% Only the code and code_server modules may call the entries below!
load_native_code/3,
- post_beam_load/2,
+ post_beam_load/1,
load_module/4,
load/3]).
@@ -120,15 +120,15 @@ load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) ->
%%========================================================================
--spec post_beam_load(atom(), hipe_architecture()) -> 'ok'.
+-spec post_beam_load([module()]) -> 'ok'.
-%% does nothing on a hipe-disabled system
-post_beam_load(_Mod, undefined) ->
+post_beam_load([])->
ok;
-post_beam_load(Mod, _) when is_atom(Mod) ->
+post_beam_load([_|_]=Mods) ->
erlang:system_flag(multi_scheduling, block),
try
- patch_to_emu(Mod)
+ _ = [patch_to_emu(Mod) || Mod <- Mods],
+ ok
after
erlang:system_flag(multi_scheduling, unblock)
end,
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
index ba40dd3168..7b233741e0 100644
--- a/lib/kernel/test/Makefile
+++ b/lib/kernel/test/Makefile
@@ -79,7 +79,8 @@ MODULES= \
zlib_SUITE \
loose_node \
sendfile_SUITE \
- standard_error_SUITE
+ standard_error_SUITE \
+ multi_load_SUITE
APP_FILES = \
appinc.app \
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index cf8863fcd0..00f29aa8ed 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -798,7 +798,7 @@ analyse2(MFA={_,_,_}, Path, Visited0) ->
analyse(FL, [MFA|Path], my_usort([MFA|Visited0]), 0).
%%%% We need to check these manually...
-% fun's are ok as long as they are defined locally.
+%% fun's are ok as long as they are defined locally.
check_funs({'$M_EXPR','$F_EXPR',_},
[{unicode,characters_to_binary_int,3},
{unicode,characters_to_binary,3},
@@ -870,6 +870,8 @@ check_funs({'$M_EXPR','$F_EXPR',1},
{hipe_unified_loader,get_refs_from,2}| _]) -> 0;
check_funs({'$M_EXPR',warning_msg,2},
[{code_server,finish_on_load_report,2} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',1},
+ [{code_server,run,2}|_]) -> 0;
%% This is cheating! /raimo
%%
%% check_funs(This = {M,_,_}, Path) ->
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
index bc14a2764d..bccca59b93 100644
--- a/lib/kernel/test/erl_prim_loader_SUITE.erl
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -29,7 +29,8 @@
inet_existing/1, inet_coming_up/1, inet_disconnects/1,
multiple_slaves/1, file_requests/1,
local_archive/1, remote_archive/1,
- primary_archive/1, virtual_dir_in_archive/1]).
+ primary_archive/1, virtual_dir_in_archive/1,
+ get_modules/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -44,7 +45,8 @@ all() ->
normalize_and_backslash, inet_existing,
inet_coming_up, inet_disconnects, multiple_slaves,
file_requests, local_archive, remote_archive,
- primary_archive, virtual_dir_in_archive].
+ primary_archive, virtual_dir_in_archive,
+ get_modules].
groups() ->
[].
@@ -109,6 +111,37 @@ get_file(Config) when is_list(Config) ->
?line error = erl_prim_loader:get_file({dummy}),
ok.
+get_modules(_Config) ->
+ MsGood = lists:sort([lists,gen_server,gb_trees,code_server]),
+ Ms = [certainly_not_existing|MsGood],
+ SuccExp = [begin
+ F = code:which(M),
+ {ok,Code} = file:read_file(F),
+ {M,{F,erlang:md5(Code)}}
+ end || M <- MsGood],
+ FailExp = [{certainly_not_existing,enoent}],
+
+ Path = code:get_path(),
+ Process = fun(_, F, Code) -> {ok,{F,erlang:md5(Code)}} end,
+ {ok,{Succ,FailExp}} = erl_prim_loader:get_modules(Ms, Process, Path),
+ SuccExp = lists:sort(Succ),
+
+ Name = inet_get_modules,
+ {ok, Node, BootPid} = complete_start_node(Name),
+ ThisDir = filename:dirname(code:which(?MODULE)),
+ true = rpc:call(Node, code, add_patha, [ThisDir]),
+ _ = rpc:call(Node, code, ensure_loaded, [?MODULE]),
+ {ok,{InetSucc,FailExp}} = rpc:call(Node, erl_prim_loader,
+ get_modules, [Ms,Process,Path]),
+ SuccExp = lists:sort(InetSucc),
+
+ stop_node(Node),
+ unlink(BootPid),
+ exit(BootPid, kill),
+
+ ok.
+
+
normalize_and_backslash(Config) ->
%% Test OTP-11170
case os:type() of
diff --git a/lib/kernel/test/multi_load_SUITE.erl b/lib/kernel/test/multi_load_SUITE.erl
new file mode 100644
index 0000000000..bb87443e36
--- /dev/null
+++ b/lib/kernel/test/multi_load_SUITE.erl
@@ -0,0 +1,412 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2012. 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(multi_load_SUITE).
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ basic_atomic_load/1,basic_errors/1,sticky_dir/1,
+ on_load_failing/1,ensure_modules_loaded/1,
+ native_code/1]).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("syntax_tools/include/merl.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic_atomic_load,basic_errors,sticky_dir,on_load_failing,
+ ensure_modules_loaded,native_code].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+basic_atomic_load(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Dir = filename:join(PrivDir, multi_load_sticky_dir),
+ _ = file:make_dir(Dir),
+
+ OldPath = code:get_path(),
+ try
+ code:add_patha(Dir),
+ do_basic(Dir)
+ after
+ code:set_path(OldPath)
+ end,
+
+ ok.
+
+do_basic(Dir) ->
+ MsVer1_0 = make_modules(5, versioned_module(1)),
+ MsVer1 = [{M,filename:absname(F, Dir),Bin} || {M,F,Bin} <- MsVer1_0],
+ _ = [ok = file:write_file(F, Bin) || {_,F,Bin} <- MsVer1],
+
+ Ms = [M || {M,_,_} <- MsVer1],
+ [] = [loaded || M <- Ms, is_loaded(M)],
+
+ ok = code:atomic_load(Ms),
+ _ = [1 = M:M() || M <- Ms],
+ _ = [F = code:which(M) || {M,F,_} <- MsVer1],
+ [] = [not_loaded || M <- Ms, not is_loaded(M)],
+
+ MsVer2 = update_modules(Ms, versioned_module(2)),
+ {ok,Prepared} = code:prepare_loading(MsVer2),
+ ok = code:finish_loading(Prepared),
+ _ = [2 = M:M() || M <- Ms],
+ _ = [F = code:which(M) || {M,F,_} <- MsVer2],
+ [] = [not_loaded || M <- Ms, not is_loaded(M)],
+
+ MsVer3 = update_modules(Ms, versioned_module(2)),
+ NotPurged = lists:sort([{M,not_purged} || M <- Ms]),
+ NotPurged = atomic_load_error(MsVer3, true),
+
+ ok.
+
+versioned_module(Ver) ->
+ fun(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-export(['@Mod@'/0]).\n",
+ "'@Mod@'() -> _@Ver@.\n"])
+ end.
+
+basic_errors(_Config) ->
+ atomic_load_fc([42]),
+ atomic_load_fc([{"mod","file","bin"}]),
+
+ finish_loading_fc(atom),
+ {ok,{PrepTag,_}} = code:prepare_loading([code]),
+ finish_loading_fc({PrepTag,[x]}),
+ finish_loading_fc({PrepTag,[{m,{<<>>,"",<<>>}}]}),
+ Prep = prepared_with_wrong_magic_bin(),
+ finish_loading_fc(Prep),
+
+ [{x,badfile}] = atomic_load_error([{x,"x",<<"bad">>}], false),
+ [{a,badfile},{some_nonexistent_file,nofile}] =
+ atomic_load_error([some_nonexistent_file,{a,"a",<<>>}],
+ false),
+
+ %% Modules mentioned more than once.
+ Mods = make_modules(2, fun basic_module/1),
+ Ms = [M || {M,_,_} <- Mods],
+ DupMods = Mods ++ [mnesia] ++ Mods ++ [mnesia],
+ DupErrors0 = lists:sort([mnesia|Ms]),
+ DupErrors = [{M,duplicated} || M <- DupErrors0],
+ DupErrors = atomic_load_error(DupMods, false),
+
+ ok.
+
+atomic_load_fc(L) ->
+ {'EXIT',{function_clause,[{code,atomic_load,[L],_}|_]}} =
+ (catch code:atomic_load(L)),
+ {'EXIT',{function_clause,[{code,prepare_loading,[L],_}|_]}} =
+ (catch code:prepare_loading(L)).
+
+finish_loading_fc(Term) ->
+ {'EXIT',{function_clause,[{code,finish_loading,[Term],_}|_]}} =
+ (catch code:finish_loading(Term)).
+
+prepared_with_wrong_magic_bin() ->
+ {ok,Prep} = code:prepare_loading([?MODULE]),
+ prep_magic(Prep).
+
+prep_magic([H|T]) ->
+ [prep_magic(H)|prep_magic(T)];
+prep_magic(Tuple) when is_tuple(Tuple) ->
+ L = prep_magic(tuple_to_list(Tuple)),
+ list_to_tuple(L);
+prep_magic(Bin) when is_binary(Bin) ->
+ try erlang:has_prepared_code_on_load(Bin) of
+ false ->
+ %% Create a different kind of magic binary.
+ ets:match_spec_compile([{'_',[true],['$_']}])
+ catch
+ _:_ ->
+ Bin
+ end;
+prep_magic(Other) ->
+ Other.
+
+sticky_dir(_Config) ->
+ Mod0 = make_module(lists, fun basic_module/1),
+ Mod1 = make_module(gen_server, fun basic_module/1),
+ Ms = [Mod0,Mod1],
+ SD = sticky_directory,
+ StickyErrors = [{gen_server,SD},{lists,SD}],
+ StickyErrors = atomic_load_error(Ms, true),
+
+ ok.
+
+on_load_failing(_Config) ->
+ OnLoad = make_modules(1, fun on_load_module/1),
+ [{OnLoadMod,_,_}] = OnLoad,
+ Ms = make_modules(10, fun basic_module/1) ++ OnLoad,
+
+ %% Fail because there is a module with on_load in the list.
+ on_load_failure(OnLoadMod, Ms),
+ on_load_failure(OnLoadMod, [lists:last(Ms)]),
+
+ %% Fail because there already is a pending on_load.
+ [{HangingOnLoad,_,_}|_] = Ms,
+ spawn_hanging_on_load(HangingOnLoad),
+ NoOnLoadMs = lists:droplast(Ms),
+ {error,[{HangingOnLoad,pending_on_load}]} =
+ code:atomic_load(NoOnLoadMs),
+ hanging_on_load ! stop_hanging_and_unload,
+
+ ok.
+
+on_load_failure(OnLoadMod, Ms) ->
+ [{OnLoadMod,on_load_not_allowed}] = atomic_load_error(Ms, false).
+
+spawn_hanging_on_load(Mod) ->
+ {Mod,Name,Bin} = make_module(Mod, "unknown",
+ fun(_) ->
+ hanging_on_load_module(Mod)
+ end),
+ spawn_link(fun() ->
+ {error,on_load_failure} =
+ code:load_binary(Mod, Name, Bin)
+ end).
+
+hanging_on_load_module(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-on_load(hang/0).\n",
+ "hang() ->\n"
+ " register(hanging_on_load, self()),\n"
+ " receive _ -> unload end.\n"]).
+
+ensure_modules_loaded(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Dir = filename:join(PrivDir, multi_load_ensure_modules_loaded),
+ _ = file:make_dir(Dir),
+
+ OldPath = code:get_path(),
+ try
+ code:add_patha(Dir),
+ do_ensure_modules_loaded(Dir)
+ after
+ code:set_path(OldPath)
+ end,
+
+ ok.
+
+do_ensure_modules_loaded(Dir) ->
+ %% Create a dummy "lists" module and place it in our code path.
+ {lists,ListsFile,ListsCode} = make_module(lists, fun basic_module/1),
+ ok = file:write_file(filename:absname(ListsFile, Dir), ListsCode),
+ {error,sticky_directory} = code:load_file(lists),
+
+ %% Make a new module that we can load.
+ Mod = make_module_file(Dir, fun basic_module/1),
+ false = is_loaded(Mod),
+
+ %% Make a new module with an on_load function.
+ OLMod = make_module_file(Dir, fun on_load_module/1),
+ false = is_loaded(OLMod),
+
+ %% lists should not be loaded again; Mod and OLMod should be
+ %% loaded. ?MODULE should not be reloaded, but there is no easy
+ %% way to test that. Repeating modules is OK.
+ ok = code:ensure_modules_loaded([?MODULE,lists,Mod,OLMod,
+ Mod,OLMod,Mod,lists]),
+ last = lists:last([last]),
+ true = is_loaded(Mod),
+ ok = Mod:Mod(),
+ true = is_loaded(OLMod),
+ _ = OLMod:module_info(),
+
+ %% Unload the modules that were loaded.
+ [begin
+ code:purge(M),
+ code:delete(M),
+ code:purge(M),
+ false = is_loaded(M)
+ end || M <- [Mod,OLMod]],
+
+ %% If there are some errors, all other modules should be loaded
+ %% anyway.
+ [{BadMod,BadFile,_}] = make_modules(1, fun basic_module/1),
+ ok = file:write_file(filename:absname(BadFile, Dir), <<"bad_code">>),
+ BadOLMod = make_module_file(Dir, fun failing_on_load_module/1),
+ BadEgg = bad__egg,
+ NativeMod = a_native_module,
+ NativeModFile = atom_to_list(NativeMod) ++ ".beam",
+ {NativeMod,_,NativeCode} = make_module(NativeMod, NativeModFile,
+ fun basic_module/1, [native]),
+ ok = file:write_file(filename:absname(NativeModFile, Dir), NativeCode),
+ ModulesToLoad = [OLMod,?MODULE,Mod,BadOLMod,NativeMod,
+ BadEgg,BadMod,lists],
+ {error,Error0} = code:ensure_modules_loaded(ModulesToLoad),
+ Error = lists:sort([{BadEgg,nofile},
+ {BadMod,badfile},
+ {BadOLMod,on_load_failure}]),
+ Error = lists:sort(Error0),
+ true = is_loaded(Mod),
+ true = is_loaded(OLMod),
+ true = is_loaded(NativeMod),
+ true = NativeMod:module_info(native),
+
+ ok.
+
+failing_on_load_module(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-on_load(f/0).\n",
+ "f() -> fail.\n"]).
+
+native_code(_Config) ->
+ case erlang:system_info(hipe_architecture) of
+ undefined ->
+ {skip,"No native support"};
+ _ ->
+ do_native_code()
+ end.
+
+do_native_code() ->
+ CalledMod = native_called_module,
+ CallingMod = native_calling_module,
+
+ %% Create a module in native code that calls another module.
+ CallingMod = make_and_load(CallingMod,
+ calling_module_fun(CalledMod),
+ [native]),
+
+ %% Create a threaded-code module.
+ _ = make_and_load(CalledMod, called_module_fun(42), []),
+ 42 = CallingMod:call(),
+
+ %% Now replace it with a changed module in native code.
+ code:purge(CalledMod),
+ make_and_load(CalledMod, called_module_fun(43), [native]),
+ true = test_server:is_native(CalledMod),
+ 43 = CallingMod:call(),
+
+ %% Reload the called module and call it.
+ code:purge(CalledMod),
+ ModVer3 = make_module(CalledMod, "", called_module_fun(changed)),
+ ok = code:atomic_load([ModVer3]),
+ false = test_server:is_native(CalledMod),
+ changed = CallingMod:call(),
+ code:purge(CalledMod),
+
+ ok.
+
+make_and_load(Mod, Fun, Opts) ->
+ {Mod,_,Code} = make_module(Mod, "", Fun, Opts),
+ {module,Mod} = code:load_binary(Mod, "", Code),
+ Mod.
+
+calling_module_fun(Called) ->
+ fun(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-export([call/0]).\n",
+ "call() -> _@Called@:f().\n"])
+ end.
+
+called_module_fun(Ret) ->
+ fun(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-export([f/0]).\n",
+ "f() -> _@Ret@.\n"])
+ end.
+
+%%%
+%%% Common utilities
+%%%
+
+atomic_load_error(Modules, ErrorInFinishLoading) ->
+ {error,Errors0} = code:atomic_load(Modules),
+ {Errors1,Bool} =
+ case code:prepare_loading(Modules) of
+ {ok,Prepared} ->
+ {error,Es0} = code:finish_loading(Prepared),
+ {Es0,true};
+ {error,Es0} ->
+ {Es0,false}
+ end,
+ Errors = lists:sort(Errors0),
+ Errors = lists:sort(Errors1),
+ case {ErrorInFinishLoading,Bool} of
+ {B,B} ->
+ Errors;
+ {false,true} ->
+ ct:fail("LastAction fun must not be called");
+ {true,false} ->
+ ct:fail("LastAction fun was not called")
+ end.
+
+is_loaded(Mod) ->
+ case erlang:module_loaded(Mod) of
+ false ->
+ false = code:is_loaded(Mod);
+ true ->
+ {file,_} = code:is_loaded(Mod),
+ true
+ end.
+
+basic_module(Mod) ->
+ ?Q(["-module('@Mod@').\n"
+ "-export(['@Mod@'/0]).\n",
+ "'@Mod@'() -> ok."]).
+
+on_load_module(Mod) ->
+ ?Q(["-module('@Mod@').\n",
+ "-on_load(f/0).\n",
+ "f() -> ok.\n"]).
+
+make_module_file(Dir, Fun) ->
+ [{Mod,File,Code}] = make_modules(1, Fun),
+ ok = file:write_file(filename:absname(File, Dir), Code),
+ Mod.
+
+make_modules(0, _) ->
+ [];
+make_modules(N, Fun) ->
+ U = erlang:unique_integer([positive]),
+ ModName = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U),
+ Mod = list_to_atom(ModName),
+ ModItem = make_module(Mod, Fun),
+ [ModItem|make_modules(N-1, Fun)].
+
+update_modules(Ms, Fun) ->
+ [make_module(M, Fun) || M <- Ms].
+
+make_module(Mod, Fun) ->
+ Filename = atom_to_list(Mod) ++ ".beam",
+ make_module(Mod, Filename, Fun).
+
+make_module(Mod, Filename, Fun) ->
+ make_module(Mod, Filename, Fun, []).
+
+make_module(Mod, Filename, Fun, Opts) ->
+ Tree = Fun(Mod),
+ merl:print(Tree),
+ {ok,Mod,Code} = merl:compile(Tree, Opts),
+ {Mod,Filename,Code}.
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 466bf139b9..2ff14dea02 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -897,6 +897,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"get_module_info"
"get_stacktrace"
"hash"
+ "has_prepared_code_on_load"
"hibernate"
"insert_element"
"is_builtin"