Move architecture knowledge out of hipe loader

Make code_server be responsible for finding the architecture and deciding
whether to try to load native code, in order to avoid repeated calls to
system_info(hipe_architecture) and clumsy uses of try/catch to test if hipe
is enabled.

2 files changed, 94 insertions, 87 deletions

diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 819554ce74..a4342715ef 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -324,12 +324,15 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
     do_load_binary(Mod, File, Bin, Caller, S);
 
 handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
-    Result = (catch hipe_unified_loader:load(Mod, Bin)),
+    Architecture = erlang:system_info(hipe_architecture),
+    Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)),
     Status = hipe_result_to_status(Result),
     {reply,Status,S};
 
 handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
-    Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)),
+    Architecture = erlang:system_info(hipe_architecture),
+    Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule,
+                                                    Architecture)),
     Status = hipe_result_to_status(Result),
     {reply,Status,S};
 
@@ -1259,30 +1262,40 @@ try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) ->
 	    error_msg("Can't load module that resides in sticky dir\n",[]),
 	    {reply,{error,sticky_directory},St};
 	false ->
-	    case catch load_native_code(Mod, Bin) of
-		{module,Mod} = Module ->
-		    ets:insert(Db, {Mod,File}),
-		    {reply,Module,St};
-		no_native ->
-		    case erlang:load_module(Mod, Bin) of
-			{module,Mod} = Module ->
-			    ets:insert(Db, {Mod,File}),
-			    post_beam_load(Mod),
-			    {reply,Module,St};
-			{error,on_load} ->
-			    handle_on_load(Mod, File, Caller, St);
-			{error,What} = Error ->
-			    error_msg("Loading of ~ts failed: ~p\n", [File, What]),
-			    {reply,Error,St}
-		    end;
-		Error ->
-		    error_msg("Native loading of ~ts failed: ~p\n",
-			      [File,Error]),
-		    {reply,ok,St}
-	    end
+            Architecture = erlang:system_info(hipe_architecture),
+            try_load_module_2(File, Mod, Bin, Caller, Architecture, St)
+    end.
+
+try_load_module_2(File, Mod, Bin, Caller, undefined, St) ->
+    try_load_module_3(File, Mod, Bin, Caller, undefined, St);
+try_load_module_2(File, Mod, Bin, Caller, Architecture,
+                  #state{moddb=Db}=St) ->
+    case catch load_native_code(Mod, Bin, Architecture) of
+        {module,Mod} = Module ->
+            ets:insert(Db, {Mod,File}),
+            {reply,Module,St};
+        no_native ->
+            try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
+        Error ->
+            error_msg("Native loading of ~ts failed: ~p\n", [File,Error]),
+            {reply,ok,St}
+    end.
+
+try_load_module_3(File, Mod, Bin, Caller, Architecture,
+                  #state{moddb=Db}=St) ->
+    case erlang:load_module(Mod, Bin) of
+        {module,Mod} = Module ->
+            ets:insert(Db, {Mod,File}),
+            post_beam_load(Mod, Architecture),
+            {reply,Module,St};
+        {error,on_load} ->
+            handle_on_load(Mod, File, Caller, St);
+        {error,What} = Error ->
+            error_msg("Loading of ~ts failed: ~p\n", [File, What]),
+            {reply,Error,St}
     end.
 
-load_native_code(Mod, Bin) ->
+load_native_code(Mod, Bin, Architecture) ->
     %% During bootstrapping of Open Source Erlang, we don't have any hipe
     %% loader modules, but the Erlang emulator might be hipe enabled.
     %% Therefore we must test for that the loader modules are available
@@ -1291,7 +1304,8 @@ load_native_code(Mod, Bin) ->
 	false ->
 	    no_native;
 	true ->
-	    Result = hipe_unified_loader:load_native_code(Mod, Bin),
+	    Result = hipe_unified_loader:load_native_code(Mod, Bin,
+                                                          Architecture),
 	    case Result of
 		{module,_} ->
 		    put(?ANY_NATIVE_CODE_LOADED, true);
@@ -1310,12 +1324,12 @@ hipe_result_to_status(Result) ->
 	    {error,Result}
     end.
 
-post_beam_load(Mod) ->
-    %% post_beam_load/1 can potentially be very expensive because it
+post_beam_load(Mod, Architecture) ->
+    %% post_beam_load/2 can potentially be very expensive because it
     %% blocks multi-scheduling; thus we want to avoid the call if we
     %% know that it is not needed.
     case get(?ANY_NATIVE_CODE_LOADED) of
-	true -> hipe_unified_loader:post_beam_load(Mod);
+	true -> hipe_unified_loader:post_beam_load(Mod, Architecture);
 	false -> ok
     end.
 
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index 949a3c9207..ddbbc548dd 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -43,10 +43,10 @@
 
 -export([chunk_name/1,
 	 %% Only the code and code_server modules may call the entries below!
-	 load_native_code/2,
-	 post_beam_load/1,
-	 load_module/3,
-	 load/2]).
+	 load_native_code/3,
+	 post_beam_load/2,
+	 load_module/4,
+	 load/3]).
 
 %%-define(DEBUG,true).
 -define(DO_ASSERT,true).
@@ -91,56 +91,48 @@ word_size(Architecture) ->
 
 %%========================================================================
 
--spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod}
-					  when Mod :: atom().
+-spec load_native_code(Mod, binary(), hipe_architecture()) ->
+                          'no_native' | {'module', Mod} when Mod :: atom().
 %% @doc
 %%    Loads the native code of a module Mod.
 %%    Returns {module,Mod} on success (for compatibility with
 %%    code:load_file/1) and the atom `no_native' on failure.
 
-load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) ->
-  Architecture = erlang:system_info(hipe_architecture),
-  try chunk_name(Architecture) of
-    ChunkTag ->
-      %% patch_to_emu(Mod),
-      case code:get_chunk(Bin, ChunkTag) of
-	undefined -> no_native;
-	NativeCode when is_binary(NativeCode) ->
-         erlang:system_flag(multi_scheduling, block),
-         try
-           OldReferencesToPatch = patch_to_emu_step1(Mod),
-           case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of
-             bad_crc -> no_native;
-             Result -> Result
-           end
-         after
-           erlang:system_flag(multi_scheduling, unblock)
-	  end
+load_native_code(_Mod, _Bin, undefined) ->
+  no_native;
+load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) ->
+  %% patch_to_emu(Mod),
+  case code:get_chunk(Bin, chunk_name(Architecture)) of
+    undefined -> no_native;
+    NativeCode when is_binary(NativeCode) ->
+      erlang:system_flag(multi_scheduling, block),
+      try
+        OldReferencesToPatch = patch_to_emu_step1(Mod),
+        case load_module(Mod, NativeCode, Bin, OldReferencesToPatch,
+                         Architecture) of
+          bad_crc -> no_native;
+          Result -> Result
+        end
+      after
+        erlang:system_flag(multi_scheduling, unblock)
       end
-  catch
-    _:_ ->
-      %% Unknown HiPE architecture. Can't happen (in principle).
-      no_native
   end.
 
 %%========================================================================
 
--spec post_beam_load(atom()) -> 'ok'.
+-spec post_beam_load(atom(), hipe_architecture()) -> 'ok'.
 
-post_beam_load(Mod) when is_atom(Mod) ->
-  Architecture = erlang:system_info(hipe_architecture),
-  try chunk_name(Architecture) of
-    _ChunkTag ->
-      erlang:system_flag(multi_scheduling, block),
-      try
-       patch_to_emu(Mod)
-      after
-       erlang:system_flag(multi_scheduling, unblock)
-      end
-  catch
-    _:_ ->
-      ok
-  end.
+%% does nothing on a hipe-disabled system
+post_beam_load(_Mod, undefined) ->
+  ok;
+post_beam_load(Mod, _) when is_atom(Mod) ->
+  erlang:system_flag(multi_scheduling, block),
+  try
+    patch_to_emu(Mod)
+  after
+    erlang:system_flag(multi_scheduling, unblock)
+  end,
+  ok.
 
 %%========================================================================
 
@@ -155,46 +147,48 @@ version_check(Version, Mod) when is_atom(Mod) ->
 
 %%========================================================================
 
--spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod}
-					when Mod :: atom().
-load_module(Mod, Bin, Beam) ->
+-spec load_module(Mod, binary(), _, hipe_architecture()) ->
+                     'bad_crc' | {'module', Mod} when Mod :: atom().
+
+load_module(Mod, Bin, Beam, Architecture) ->
   erlang:system_flag(multi_scheduling, block),
   try
-    load_module_nosmp(Mod, Bin, Beam)
+    load_module_nosmp(Mod, Bin, Beam, Architecture)
   after
     erlang:system_flag(multi_scheduling, unblock)
   end.
 
-load_module_nosmp(Mod, Bin, Beam) ->
-  load_module(Mod, Bin, Beam, []).
+load_module_nosmp(Mod, Bin, Beam, Architecture) ->
+  load_module(Mod, Bin, Beam, [], Architecture).
 
-load_module(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
   ?debug_msg("************ Loading Module ~w ************\n",[Mod]),
   %% Loading a whole module, let the BEAM loader patch closures.
   put(hipe_patch_closures, false),
-  load_common(Mod, Bin, Beam, OldReferencesToPatch).
+  load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture).
 
 %%========================================================================
 
--spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom().
+-spec load(Mod, binary(), hipe_architecture()) ->
+              'bad_crc' | {'module', Mod} when Mod :: atom().
 
-load(Mod, Bin) ->
+load(Mod, Bin, Architecture) ->
   erlang:system_flag(multi_scheduling, block),
   try
-    load_nosmp(Mod, Bin)
+    load_nosmp(Mod, Bin, Architecture)
   after
     erlang:system_flag(multi_scheduling, unblock)
   end.
 
-load_nosmp(Mod, Bin) ->
+load_nosmp(Mod, Bin, Architecture) ->
   ?debug_msg("********* Loading funs in module ~w *********\n",[Mod]),
   %% Loading just some functions in a module; patch closures separately.
   put(hipe_patch_closures, true),
-  load_common(Mod, Bin, [], []).
+  load_common(Mod, Bin, [], [], Architecture).
 
 %%------------------------------------------------------------------------
 
-load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
   %% Unpack the binary.
   [{Version, CheckSum},
    ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap,
@@ -219,7 +213,6 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
       bad_crc;
     true ->
       put(closures_to_patch, []),
-      Architecture=erlang:system_info(hipe_architecture),
       WordSize = word_size(Architecture),
       WriteWord = write_word_fun(WordSize),
       %% Create data segment
@@ -834,7 +827,7 @@ address_to_mfa_lth(_Address, [], Prev) ->
 
 %%----------------------------------------------------------------
 %% Change callers of the given module to instead trap to BEAM.
-%% load_native_code/2 calls this just before loading native code.
+%% load_native_code/3 calls this just before loading native code.
 %%
 patch_to_emu(Mod) ->
   patch_to_emu_step2(patch_to_emu_step1(Mod)).