Merge branch 'bjorn/erts/old-code-checking-improvements/OTP-9495' into dev

* bjorn/erts/old-code-checking-improvements/OTP-9495:
  code: Optimize purge/1 and soft_purge/1 using check_old_code/1
  Add erlang:check_old_code/1
  check_process_code/2: Quickly return 'false' if there is no old code

6 files changed, 89 insertions, 13 deletions

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 7cfab0785d..ad7a57bd73 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -518,6 +518,18 @@
     </func>
 
     <func>
+      <name>check_old_code(Module) -> boolean()</name>
+      <fsummary>Check if a module has old code</fsummary>
+      <type>
+        <v>Module = atom()</v>
+      </type>
+      <desc>
+        <p>Returns <c>true</c> if the <c>Module</c> has old code,
+	and <c>false</c> otherwise.</p>
+        <p>See also <seealso marker="kernel:code">code(3)</seealso>.</p>
+      </desc>
+    </func>
+    <func>
       <name>check_process_code(Pid, Module) -> boolean()</name>
       <fsummary>Check if a process is executing old code for a module</fsummary>
       <type>
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index d76a7d8e9f..2561d7a630 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -162,6 +162,23 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
     return res;
 }
 
+BIF_RETTYPE
+check_old_code_1(BIF_ALIST_1)
+{
+    Module* modp;
+
+    if (is_not_atom(BIF_ARG_1)) {
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    modp = erts_get_module(BIF_ARG_1);
+    if (modp == NULL) {		/* Doesn't exist. */
+	BIF_RET(am_false);
+    } else if (modp->old_code == NULL) { /* No old code. */
+	BIF_RET(am_false);
+    }
+    BIF_RET(am_true);
+}
+
 Eterm
 check_process_code_2(BIF_ALIST_2)
 {
@@ -175,6 +192,13 @@ check_process_code_2(BIF_ALIST_2)
 	Eterm res;
 	if (internal_pid_index(BIF_ARG_1) >= erts_max_processes)
 	    goto error;
+	modp = erts_get_module(BIF_ARG_2);
+	if (modp == NULL) {		/* Doesn't exist. */
+	    return am_false;
+	} else if (modp->old_code == NULL) { /* No old code. */
+	    return am_false;
+	}
+	
 #ifdef ERTS_SMP
 	rp = erts_pid2proc_suspend(BIF_P, ERTS_PROC_LOCK_MAIN,
 				   BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
@@ -188,7 +212,6 @@ check_process_code_2(BIF_ALIST_2)
 	    ERTS_BIF_YIELD2(bif_export[BIF_check_process_code_2], BIF_P,
 			    BIF_ARG_1, BIF_ARG_2);
 	}
-	modp = erts_get_module(BIF_ARG_2);
 	res = check_process_code(rp, modp);
 #ifdef ERTS_SMP
 	if (BIF_P != rp) {
@@ -412,11 +435,6 @@ check_process_code(Process* rp, Module* modp)
 #endif
 
 #define INSIDE(a) (start <= (a) && (a) < end)
-    if (modp == NULL) {		/* Doesn't exist. */
-	return am_false;
-    } else if (modp->old_code == NULL) { /* No old code. */
-	return am_false;
-    }
 
     /*
      * Pick up limits for the module.
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index d9dd80fa8b..b171e99e03 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -802,6 +802,12 @@ bif prim_file:internal_name2native/1
 bif prim_file:internal_native2name/1
 bif prim_file:internal_normalize_utf8/1
 bif file:native_name_encoding/0
+
+#
+# New in R14B04.
+#
+bif erlang:check_old_code/1
+
 #
 # Obsolete
 #
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index a062cea117..29cbdedd17 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -20,7 +20,9 @@
 -module(code_SUITE).
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2,
-	 new_binary_types/1,t_check_process_code/1,t_check_process_code_ets/1,
+	 new_binary_types/1,
+	 t_check_process_code/1,t_check_old_code/1,
+	 t_check_process_code_ets/1,
 	 external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
 	 make_stub_many_funs/1,constant_pools/1,
 	 false_dependency/1,coverage/1]).
@@ -31,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
     [new_binary_types, t_check_process_code,
-     t_check_process_code_ets, external_fun, get_chunk,
+     t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
      module_md5, make_stub, make_stub_many_funs,
      constant_pools, false_dependency, coverage].
 
@@ -248,6 +250,32 @@ fun_refc(F) ->
     Count.
 
 
+%% Test the erlang:check_old_code/1 BIF.
+t_check_old_code(Config) when is_list(Config) ->
+    ?line Data = ?config(data_dir, Config),
+    ?line File = filename:join(Data, "my_code_test"),
+
+    ?line erlang:purge_module(my_code_test),
+    ?line erlang:delete_module(my_code_test),
+    ?line catch erlang:purge_module(my_code_test),
+
+    ?line false = erlang:check_old_code(my_code_test),
+
+    ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
+    ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code),
+    
+    ?line false = erlang:check_old_code(my_code_test),
+    ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code),
+    ?line true = erlang:check_old_code(my_code_test),
+
+    ?line true = erlang:purge_module(my_code_test),
+    ?line true = erlang:delete_module(my_code_test),
+    ?line true = erlang:purge_module(my_code_test),
+
+    ?line {'EXIT',_} = (catch erlang:check_old_code([])),
+    
+    ok.
+
 external_fun(Config) when is_list(Config) ->
     ?line false = erlang:function_exported(another_code_test, x, 1),
     ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1),
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index f1be658054..82e3675938 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -672,6 +672,9 @@ type(erlang, call_on_load_function, 1, Xs) ->
 type(erlang, cancel_timer, 1, Xs) ->
   strict(arg_types(erlang, cancel_timer, 1), Xs,
 	 fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(erlang, check_old_code, 1, Xs) ->
+  strict(arg_types(erlang, check_old_code, 1), Xs,
+	 fun (_) -> t_boolean() end);
 type(erlang, check_process_code, 2, Xs) ->
   strict(arg_types(erlang, check_process_code, 2), Xs,
 	 fun (_) -> t_boolean() end);
@@ -3395,6 +3398,8 @@ arg_types(erlang, call_on_load_function, 1) ->
   [t_atom()];
 arg_types(erlang, cancel_timer, 1) ->
   [t_reference()];
+arg_types(erlang, check_old_code, 1) ->
+  [t_atom()];
 arg_types(erlang, check_process_code, 2) ->
   [t_pid(), t_atom()];
 arg_types(erlang, concat_binary, 1) ->
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 4a1fc7df34..85bbff9cc3 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -1379,8 +1379,12 @@ absname_vr([[X, $:]|Name], _, _AbsBase) ->
 %%  Kill all processes running code from *old* Module, and then purge the
 %%  module. Return true if any processes killed, else false.
 
-do_purge(Mod) ->
-    do_purge(processes(), to_atom(Mod), false).
+do_purge(Mod0) ->
+    Mod = to_atom(Mod0),
+    case erlang:check_old_code(Mod) of
+	false -> false;
+	true -> do_purge(processes(), Mod, false)
+    end.
 
 do_purge([P|Ps], Mod, Purged) ->
     case erlang:check_process_code(P, Mod) of
@@ -1399,16 +1403,19 @@ do_purge([], Mod, Purged) ->
     Purged.
 
 %% do_soft_purge(Module)
-%% Purge old code only if no procs remain that run old code
+%% 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_soft_purge(Mod) ->
-    catch do_soft_purge(processes(), Mod).
+    case erlang:check_old_code(Mod) of
+	false -> true;
+	true -> do_soft_purge(processes(), Mod)
+    end.
 
 do_soft_purge([P|Ps], Mod) ->
     case erlang:check_process_code(P, Mod) of
-	true -> throw(false);
+	true -> false;
 	false -> do_soft_purge(Ps, Mod)
     end;
 do_soft_purge([], Mod) ->