Fix crash when calling a module with an on_load attribute from a nati…

…ve module

The fix consists in adding a new opcode for hipe stub calls.

It is based on the following understanding of the loader: when
a module is loaded, the export entries are first allocated as
stubs to call_error_handler, which loads the function or
generates an error. Then, the entries are updated with the address
to the function, except when the module has an on_load attribute.
Export entries of modules with an on_load attribute are not made
callable immediatly. Instead, the function address is saved and
the on_load function is called. If this succeeds, the entry is
finally fixed. The issue is that hipe can generate a stub with
a pointer to the call_error_handler opcode set the loader before
on_load function is called.

The fix consists in updating the call_error_handler opcode with
a new opcode that simply calls the loaded function.

erts/emulator/beam/beam_bif_load.c

@@ -336,9 +336,12 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
 	    if (ep != NULL &&
 		ep->code[0] == BIF_ARG_1 &&
 		ep->code[4] != 0) {
+		/* the fixed address is in ep->code[4], see final_touch in beam_load */
 		ep->address = (void *) ep->code[4];
-		ep->code[3] = 0;
-		ep->code[4] = 0;
+		/* any hipe stub to this function points to ep->code[3], which in turn
+		is em_call_error_handler (to load the module). Since the function is
+		loaded, we can jump to it directly with em_call_from_hipe_stub */
+		ep->code[3] = em_call_from_hipe_stub;
 	    }
 	}
 	modp->code[MI_ON_LOAD_FUNCTION_PTR] = 0;

erts/emulator/beam/beam_emu.c

@@ -221,6 +221,7 @@ BeamInstr beam_continue_exit[1];
 BeamInstr* em_call_error_handler;
 BeamInstr* em_apply_bif;
 BeamInstr* em_call_traced_function;
+BeamInstr* em_call_from_hipe_stub;
 
 
 /* NOTE These should be the only variables containing trace instructions.
@@ -3043,6 +3044,22 @@ void process_main(void)
      goto post_error_handling;
  }
 
+    /*
+     * At this point, I points to the code[3] in the export entry for
+     * a loaded function with a hipe stub.
+     *
+     * code[0]: Module
+     * code[1]: Function
+     * code[2]: Arity
+     * code[3]: &&call_from_hipe_stub
+     * code[4]: Address of function.
+     */
+ OpCase(call_from_hipe_stub): {
+     /* We might want to fix the stub (?) to earn few cycles */
+     SET_I((BeamInstr *)Arg(0));
+     Goto(*I);
+ }
+
  OpCase(call_error_handler):
     /*
      * At this point, I points to the code[3] in the export entry for
@@ -5034,6 +5051,7 @@ void process_main(void)
      em_call_error_handler = OpCode(call_error_handler);
      em_call_traced_function = OpCode(call_traced_function);
      em_apply_bif = OpCode(apply_bif);
+     em_call_from_hipe_stub = OpCode(call_from_hipe_stub);
 
      beam_apply[0]             = (BeamInstr) OpCode(i_apply);
      beam_apply[1]             = (BeamInstr) OpCode(normal_exit);

erts/emulator/beam/beam_load.h

@@ -48,6 +48,7 @@ extern BeamInstr beam_debug_apply[];
 extern BeamInstr* em_call_error_handler;
 extern BeamInstr* em_apply_bif;
 extern BeamInstr* em_call_traced_function;
+extern BeamInstr* em_call_from_hipe_stub;
 typedef struct {
     BeamInstr* start;		/* Pointer to start of module. */
     BeamInstr* end;			/* Points one word beyond last function in module. */

erts/emulator/beam/export.h

@@ -45,11 +45,12 @@ typedef struct export
      * code[3]: This entry is 0 unless the 'address' field points to it.
      *          Threaded code instruction to load function
      *		(em_call_error_handler), execute BIF (em_apply_bif,
-     *		em_apply_apply), or call a traced function
-     *		(em_call_traced_function).
+     *		em_apply_apply), call a traced function
+     *		(em_call_traced_function) or call a loaded function (for hipe stub
+     *      of on_load modules).
      * code[4]: Function pointer to BIF function (for BIFs only)
      *		or pointer to threaded code if the module has an
-     *		on_load function that has not been run yet.
+     *		on_load function.
      *		Otherwise: 0.
      */
     BeamInstr code[5];

erts/emulator/test/Makefile

@@ -66,6 +66,7 @@ MODULES= \
 	guard_SUITE \
 	hash_SUITE \
 	hibernate_SUITE \
+	hipe_SUITE \
 	list_bif_SUITE \
 	match_spec_SUITE \
 	module_info_SUITE \

erts/emulator/test/hipe_SUITE.erl

@@ -0,0 +1,69 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_SUITE).
+
+-include("test_server.hrl").
+
+%% Test server specific exports
+-export([all/1, init_per_suite/1, end_per_suite/1]).
+
+%% Test cases
+-export([call_beam_module_with_on_load/1]).
+
+all(suite) ->
+    [call_beam_module_with_on_load].
+
+init_per_suite(Config) when is_list(Config) ->
+    case erlang:system_info(hipe_architecture) of
+	undefined ->
+	    {skip, "Native code support is not enabled"};
+	_ ->
+	    Config
+    end.
+
+end_per_suite(Config) when is_list(Config) ->
+    ok.
+
+call_beam_module_with_on_load(suite) ->
+    [];
+call_beam_module_with_on_load(doc) ->
+    ["Test that we can call a non-native module with a on_load from a native module"];
+call_beam_module_with_on_load(Config) when is_list(Config) ->
+    ?line DataDir = ?config(data_dir, Config),
+    ?line CallerModule = filename:join(DataDir, "native_caller.erl"),
+    ?line CalleeModule = filename:join(DataDir, "beam_callee.erl"),
+    ?line PrivDir = ?config(priv_dir, Config),
+    test_call_with_on_load(PrivDir, CallerModule, CalleeModule).
+
+test_call_with_on_load(PrivDir, CallerModule, CalleeModule) ->
+    % Compile both modules.
+    ?line {ok, CallerModuleName} = compile:file(CallerModule, [{outdir, PrivDir}]),
+    ?line {ok, CalleeModuleName} = compile:file(CalleeModule, [{outdir, PrivDir}]),
+    % Add PrivDir to the path so we can load modules interactively.
+    AbsPrivDir = filename:absname(PrivDir),
+    ?line true = code:add_patha(AbsPrivDir),
+    % Call the function in caller module.
+    ?line ok = CallerModuleName:call(CalleeModuleName),
+    % Purge both modules now.
+    ?line true = code:soft_purge(CallerModuleName),
+    ?line true = code:soft_purge(CalleeModuleName),
+    % Remove PrivDir from the path.
+    ?line true = code:del_path(AbsPrivDir),
+    ok.

erts/emulator/test/hipe_SUITE_data/beam_callee.erl

@@ -0,0 +1,10 @@
+-module(beam_callee).
+-on_load(on_load/0).
+-export([f/0]).
+
+on_load() ->
+    ok.
+
+f() ->
+    false = code:is_module_native(?MODULE),
+    ok.

erts/emulator/test/hipe_SUITE_data/native_caller.erl

@@ -0,0 +1,9 @@
+-module(native_caller).
+-compile([native]).
+-export([call/1]).
+
+call(CalleeModuleName) ->
+    true = code:is_module_native(?MODULE),
+    ok = CalleeModuleName:f(),
+    ok = CalleeModuleName:f(),
+    ok.