Merge branch 'bjorn/multiple-load/OTP-13111'

* bjorn/multiple-load/OTP-13111:
  code: Add functions that can load multiple modules
  Refactor post_beam_load handling
  Simplify and robustify code_server:all_loaded/1
  Update preloaded modules
  Add erl_prim_loader:get_modules/3
  Add has_prepared_code_on_load/1 BIF
  Allow erlang:finish_loading/1 to load more than one module
  beam_load.c: Add a function to check for an on_load function

3 files changed, 402 insertions, 38 deletions

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,