Merge branch 'richcarl/md5-fixes'

* richcarl/md5-fixes:
  Set module_info md5 for native modules properly
  Add module_info entry for native code
  Gracefully handle empty md5 field in module_info
  Remove 'imports' key from spec of get_module_info()

6 files changed, 94 insertions, 43 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 282aa71109..0d40201934 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;
 }
@@ -5493,6 +5499,53 @@ functions_in_module(Process* p, /* Process whose heap to use. */
 }
 
 /*
+ * 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},...]
  *
@@ -5695,7 +5748,11 @@ md5_of_module(Process* p, /* Process whose heap to use. */
 	return THE_NON_VALUE;
     }
     code = modp->curr.code;
-    res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+    if (code[MI_MD5_PTR] != 0) {
+      res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+    } else {
+      res = am_undefined;
+    }
     return res;
 }
 
@@ -6168,6 +6225,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     LoaderState* stp;
     BeamInstr Funcs;
     BeamInstr Patchlist;
+    Eterm MD5Bin;
     Eterm* tp;
     BeamInstr* code = NULL;
     BeamInstr* ptrs;
@@ -6196,12 +6254,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
 	goto error;
     }
     tp = tuple_val(Info);
-    if (tp[0] != make_arityval(2)) {
+    if (tp[0] != make_arityval(3)) {
       goto error;
     }
     Funcs = tp[1];
-    Patchlist = tp[2];        
-   
+    Patchlist = tp[2];
+    MD5Bin = tp[3];
+    if (is_not_binary(MD5Bin) || (binary_size(MD5Bin) != MD5_SIZE)) {
+	goto error;
+    }
     if ((n = erts_list_length(Funcs)) < 0) {
 	goto error;
     }
@@ -6251,6 +6312,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
     code_size += stp->chunks[ATTR_CHUNK].size;
     code_size += stp->chunks[COMPILE_CHUNK].size;
+    code_size += MD5_SIZE;
     code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
     if (!code) {
 	goto error;
@@ -6357,6 +6419,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     if (info == NULL) {
 	goto error;
     }
+    {
+      byte *tmp = NULL;
+      byte *md5 = NULL;
+      if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) {
+        sys_memcpy(info, md5, MD5_SIZE);
+        code[MI_MD5_PTR] = (BeamInstr) info;
+      }
+      erts_free_aligned_binary_bytes(tmp);
+    }
 
     /*
      * Insert the module in the module table.
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/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index b0408cabe1..df7c8ed1d1 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -389,61 +389,63 @@ module_md5_ok(Code) ->
 
 make_stub(Config) when is_list(Config) ->
     catch erlang:purge_module(my_code_test),
+    MD5 = erlang:md5(<<>>),
 
     ?line Data = ?config(data_dir, Config),
     ?line File = filename:join(Data, "my_code_test"),
     ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
 
-    ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[]}),
+    ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}),
     ?line true = erlang:delete_module(my_code_test),
     ?line true = erlang:purge_module(my_code_test),
 
     ?line my_code_test = code:make_stub_module(my_code_test, 
  					       make_unaligned_sub_binary(Code),
- 					       {[],[]}),
+ 					       {[],[],MD5}),
     ?line true = erlang:delete_module(my_code_test),
     ?line true = erlang:purge_module(my_code_test),
 
     ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code),
- 					       {[],[]}),
+ 					       {[],[],MD5}),
     ?line true = erlang:delete_module(my_code_test),
     ?line true = erlang:purge_module(my_code_test),
 
     %% Should fail.
     ?line {'EXIT',{badarg,_}} =
-	(catch code:make_stub_module(my_code_test, <<"bad">>, {[],[]})),
+	(catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})),
     ?line {'EXIT',{badarg,_}} =
 	(catch code:make_stub_module(my_code_test,
 				     bit_sized_binary(Code),
-				     {[],[]})),
+				     {[],[],MD5})),
     ?line {'EXIT',{badarg,_}} =
 	(catch code:make_stub_module(my_code_test_with_wrong_name,
-				     Code, {[],[]})),
+				     Code, {[],[],MD5})),
     ok.
 
 make_stub_many_funs(Config) when is_list(Config) ->
     catch erlang:purge_module(many_funs),
+    MD5 = erlang:md5(<<>>),
 
     ?line Data = ?config(data_dir, Config),
     ?line File = filename:join(Data, "many_funs"),
     ?line {ok,many_funs,Code} = compile:file(File, [binary]),
 
-    ?line many_funs = code:make_stub_module(many_funs, Code, {[],[]}),
+    ?line many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}),
     ?line true = erlang:delete_module(many_funs),
     ?line true = erlang:purge_module(many_funs),
     ?line many_funs = code:make_stub_module(many_funs, 
  					       make_unaligned_sub_binary(Code),
- 					       {[],[]}),
+ 					       {[],[],MD5}),
     ?line true = erlang:delete_module(many_funs),
     ?line true = erlang:purge_module(many_funs),
 
     %% Should fail.
     ?line {'EXIT',{badarg,_}} =
-	(catch code:make_stub_module(many_funs, <<"bad">>, {[],[]})),
+	(catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})),
     ?line {'EXIT',{badarg,_}} =
 	(catch code:make_stub_module(many_funs,
 				     bit_sized_binary(Code),
-				     {[],[]})),
+				     {[],[],MD5})),
     ok.
 
 constant_pools(Config) when is_list(Config) ->
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/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index fd11c101bc..629702fc1c 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -1931,7 +1931,7 @@ element(_N, _Tuple) ->
 %% Not documented
 -spec erlang:get_module_info(Module, Item) -> ModuleInfo when
       Module :: atom(),
-      Item :: module | imports | exports | functions | attributes | compile | native_addresses | md5,
+      Item :: module | exports | functions | attributes | compile | native_addresses | md5,
       ModuleInfo :: atom() | [] | [{atom(), arity()}] | [{atom(), term()}] | [{atom(), arity(), integer()}].
 get_module_info(_Module, _Item) ->
     erlang:nif_error(undefined).