From fc1029c74093fde14241ca664c9341fcc8be5fd3 Mon Sep 17 00:00:00 2001
From: Richard Carlsson <richardc@klarna.com>
Date: Thu, 16 Apr 2015 14:30:55 +0200
Subject: Add module_info entry for native code

---
 erts/emulator/beam/beam_bif_load.c       | 29 ++---------------
 erts/emulator/beam/beam_load.c           | 53 ++++++++++++++++++++++++++++++++
 erts/emulator/beam/beam_load.h           |  2 +-
 erts/emulator/test/module_info_SUITE.erl |  3 ++
 lib/test_server/src/test_server.erl      |  6 +---
 system/doc/reference_manual/modules.xml  | 10 +++++-
 6 files changed, 69 insertions(+), 34 deletions(-)

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index df1983a83d..8c32fc7854 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -39,12 +39,9 @@ static void set_default_trace_pattern(Eterm module);
 static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
 static void delete_code(Module* modp);
 static void decrement_refc(BeamInstr* code);
-static int is_native(BeamInstr* code);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 
-
-
 BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
 {
     Module* modp;
@@ -59,8 +56,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
 	return am_undefined;
     }
     erts_rlock_old_code(code_ix);
-    res = ((modp->curr.code && is_native(modp->curr.code)) ||
-	    (modp->old.code != 0 && is_native(modp->old.code))) ?
+    res = (erts_is_module_native(modp->curr.code) ||
+           erts_is_module_native(modp->old.code)) ?
 		am_true : am_false;
     erts_runlock_old_code(code_ix);
     return res;
@@ -1106,25 +1103,3 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
     }
     return NIL;
 }
-
-static int
-is_native(BeamInstr* code)
-{
-    Uint i, num_functions = code[MI_NUM_FUNCTIONS];
-
-    /* Check NativeAdress of first real function in module
-     */
-    for (i=0; i<num_functions; i++) {
-	BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
-	Eterm name = (Eterm) func_info[3];
-
-	if (is_atom(name)) {
-	    return func_info[1] != 0;    
-	}
-	else ASSERT(is_nil(name)); /* ignore BIF stubs */
-    }
-    /* Not a single non-BIF function? */
-    return 0;
-}
-
-
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 29d4dce3e2..e2bd30bd6b 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -530,6 +530,7 @@ static Eterm functions_in_module(Process* p, Eterm mod);
 static Eterm attributes_for_module(Process* p, Eterm mod);
 static Eterm compilation_info_for_module(Process* p, Eterm mod);
 static Eterm md5_of_module(Process* p, Eterm mod);
+static Eterm has_native(Process* p, Eterm mod);
 static Eterm native_addresses(Process* p, Eterm mod);
 int patch_funentries(Eterm Patchlist);
 int patch(Eterm Addresses, Uint fe);
@@ -5408,6 +5409,9 @@ erts_module_info_0(Process* p, Eterm module)
     list = CONS(hp, tup, list)
 
     BUILD_INFO(am_md5);
+#ifdef HIPE
+    BUILD_INFO(am_native);
+#endif
     BUILD_INFO(am_compile);
     BUILD_INFO(am_attributes);
     BUILD_INFO(am_exports);
@@ -5433,6 +5437,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
 	return compilation_info_for_module(p, module);
     } else if (what == am_native_addresses) {
 	return native_addresses(p, module);
+    } else if (what == am_native) {
+	return has_native(p, module);
     }
     return THE_NON_VALUE;
 }
@@ -5492,6 +5498,53 @@ functions_in_module(Process* p, /* Process whose heap to use. */
     return result;
 }
 
+/*
+ * Returns 'true' if mod has any native compiled functions, otherwise 'false'
+ */
+
+static Eterm
+has_native(Process* p, Eterm mod)
+{
+    Eterm result = am_false;
+#ifdef HIPE
+    Module* modp;
+
+    if (is_not_atom(mod)) {
+        return THE_NON_VALUE;
+    }
+
+    modp = erts_get_module(mod, erts_active_code_ix());
+    if (modp == NULL) {
+        return THE_NON_VALUE;
+    }
+
+    if (erts_is_module_native(modp->curr.code)) {
+      result = am_true;
+    }
+#endif
+    return result;
+}
+
+int
+erts_is_module_native(BeamInstr* code)
+{
+    Uint i, num_functions;
+
+    /* Check NativeAdress of first real function in module */
+    if (code != NULL) {
+        num_functions = code[MI_NUM_FUNCTIONS];
+        for (i=0; i<num_functions; i++) {
+            BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+            Eterm name = (Eterm) func_info[3];
+            if (is_atom(name)) {
+                return func_info[1] != 0;
+            }
+            else ASSERT(is_nil(name)); /* ignore BIF stubs */
+        }
+    }
+    return 0;
+}
+
 /*
  * Builds a list of all functions including native addresses.
  *     [{Name,Arity,NativeAddress},...]
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 0e3ca0bdb0..46b0c60ab0 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -23,10 +23,10 @@
 #include "beam_opcodes.h"
 #include "erl_process.h"
 
+int erts_is_module_native(BeamInstr* code);
 Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
 			    Eterm module);
 
-
 typedef struct gen_op_entry {
    char* name;
    int arity;
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index f3986f0c4f..1125cf3072 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -94,12 +94,15 @@ functions(Config) when is_list(Config) ->
     ok.
 
 %% Test that the list of exported functions from this module is correct.
+%% Verify that module_info(native) works.
 native(Config) when is_list(Config) ->
     ?line All = all_functions(),
     ?line case ?MODULE:module_info(native_addresses) of
 	      [] ->
+                  ?line false = ?MODULE:module_info(native),
 		  {comment,"no native functions"};
 	      L ->
+                  ?line true = ?MODULE:module_info(native),
 		  %% Verify that all functions have unique addresses.
 		  ?line S0 = sofs:set(L, [{name,arity,addr}]),
 		  ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0),
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 7cb9c4bb5a..785e687b92 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -2491,11 +2491,7 @@ appup_test(App) ->
 %% Checks wether the module is natively compiled or not.
 
 is_native(Mod) ->
-    case catch Mod:module_info(native_addresses) of
-	[_|_] -> true;
-	_Other -> false
-    end.
-
+    (catch Mod:module_info(native)) =:= true.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% comment(String) -> ok
diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml
index 39c739a146..76767ea686 100644
--- a/system/doc/reference_manual/modules.xml
+++ b/system/doc/reference_manual/modules.xml
@@ -246,7 +246,8 @@ behaviour_info(callbacks) -> Callbacks.</pre>
       a list of <c>{Key,Value}</c> tuples with information about
       the module. Currently, the list contain tuples with the following
       <c>Key</c>s: <c>module</c>, <c>attributes</c>, <c>compile</c>,
-      <c>exports</c> and <c>md5</c>. The order and number of tuples
+      <c>exports</c>, <c>md5</c> and <c>native</c>.
+      The order and number of tuples
       may change without prior notice.</p>
     </section>
 
@@ -302,6 +303,13 @@ behaviour_info(callbacks) -> Callbacks.</pre>
 	  <p>Returns a list of <c>{Name,Arity}</c> tuples with
 	  all functions in the module.</p>
 	  </item>
+
+        <tag><c>native</c></tag>
+	  <item>
+	  <p>Return <c>true</c> if the module has native compiled code.
+          Return <c>false</c> otherwise. In a system compiled without HiPE
+          support, the result is always <c>false</c></p>
+	  </item>
       </taglist>
     </section>
   </section>
-- 
cgit v1.2.3