Merge branch 'sverk/safe-purging/OTP-13122'

* sverk/safe-purging/OTP-13122:
  erts: Ignore unexpected messages to erts_code_purger
  erts: Optimize erlang:check_process_code
  erts: Refactor check_process_code/3
  erts: Make copy_literals more fail safe
  erts: Move copy_literals/2 from erlang to erts_internal
  erts: Make erlang:purge_module/1 safe
  erts: Refactor code:purge/1 and code:soft_purge/1
  erts: Introduce erts_code_purger

4 files changed, 37 insertions, 247 deletions

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].
 
 %%______________________________________________________________________