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

3 files changed, 60 insertions, 8 deletions

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),