Merge branch 'sverker/hipe-fun-purge'

8 files changed, 212 insertions, 162 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 36cf64e08d..3cd395c2c1 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4848,7 +4848,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
 	    }
 	    fe->address = code_ptr;
 #ifdef HIPE
-	    hipe_set_closure_stub(fe, stp->lambdas[i].num_free);
+	    hipe_set_closure_stub(fe);
 #endif
 	}
     }
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index acb0d609d0..d9118d2549 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -31,6 +31,9 @@
 static Hash erts_fun_table;
 
 #include "erl_smp.h"
+#ifdef HIPE
+# include "hipe_mode_switch.h"
+#endif
 
 static erts_smp_rwmtx_t erts_fun_table_lock;
 
@@ -219,6 +222,10 @@ erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end)
 		fe->pend_purge_address = addr;
 		ERTS_SMP_WRITE_MEMORY_BARRIER;
 		fe->address = unloaded_fun;
+#ifdef HIPE
+                fe->pend_purge_native_address = fe->native_address;
+                hipe_set_closure_stub(fe);
+#endif
 		erts_purge_state_add_fun(fe);
 	    }
 	    b = b->next;
@@ -234,8 +241,12 @@ erts_fun_purge_abort_prepare(ErlFunEntry **funs, Uint no)
 
     for (ix = 0; ix < no; ix++) {
 	ErlFunEntry *fe = funs[ix];
-	if (fe->address == unloaded_fun)
+	if (fe->address == unloaded_fun) {
 	    fe->address = fe->pend_purge_address;
+#ifdef HIPE
+            fe->native_address = fe->pend_purge_native_address;
+#endif
+        }
     }
 }
 
@@ -244,8 +255,12 @@ erts_fun_purge_abort_finalize(ErlFunEntry **funs, Uint no)
 {
     Uint ix;
 
-    for (ix = 0; ix < no; ix++)
+    for (ix = 0; ix < no; ix++) {
 	funs[ix]->pend_purge_address = NULL;
+#ifdef HIPE
+        funs[ix]->pend_purge_native_address = NULL;
+#endif
+    }
 }
 
 void
@@ -256,6 +271,9 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
     for (ix = 0; ix < no; ix++) {
 	ErlFunEntry *fe = funs[ix];
 	fe->pend_purge_address = NULL;
+#ifdef HIPE
+        fe->pend_purge_native_address = NULL;
+#endif
 	if (erts_refc_dectest(&fe->refc, 0) == 0)
 	    erts_erase_fun_entry(fe);
     }
@@ -324,6 +342,7 @@ fun_alloc(ErlFunEntry* template)
     obj->pend_purge_address = NULL;
 #ifdef HIPE
     obj->native_address = NULL;
+    obj->pend_purge_native_address = NULL;
 #endif
     return obj;
 }
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index 6ba055d92c..717bfee0fb 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -45,6 +45,9 @@ typedef struct erl_fun_entry {
     erts_refc_t refc;		/* Reference count: One for code + one for each
 				   fun object in each process. */
     BeamInstr *pend_purge_address; /* address stored during a pending purge */
+#ifdef HIPE
+    UWord* pend_purge_native_address;
+#endif
 } ErlFunEntry;
 
 /*
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 98df8a0726..a49b242d7c 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -3748,7 +3748,7 @@ dec_term_atom_common:
 		funp->arity = arity;
 #ifdef HIPE
 		if (funp->fe->native_address == NULL) {
-		    hipe_set_closure_stub(funp->fe, num_free);
+		    hipe_set_closure_stub(funp->fe);
 		}
 #endif
 		hp = factory->hp;
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index ed95045292..0706f8d2c9 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -718,12 +718,9 @@ void hipe_empty_nstack(Process *p)
     p->hipe.nstend = NULL;
 }
 
-void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free)
+void hipe_set_closure_stub(ErlFunEntry *fe)
 {
-    unsigned arity;
-
-    arity = fe->arity;
-    fe->native_address = (Eterm*) hipe_closure_stub_address(arity);
+    fe->native_address = (Eterm*) hipe_closure_stub_address(fe->arity);
 }
 
 Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s)
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index c40077d558..334e978307 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -59,7 +59,7 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure);
 Process *hipe_mode_switch(Process*, unsigned, Eterm*);
 void hipe_inc_nstack(Process *p);
 void hipe_empty_nstack(Process *p);
-void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free);
+void hipe_set_closure_stub(ErlFunEntry *fe);
 Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s);
 
 ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity);
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 465ddfa7a8..774461c525 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -153,127 +153,23 @@ call_purged_fun_code_there(Config) when is_list(Config) ->
     ok.
 
 call_purged_fun_test(Priv, Data, Type) ->
-    File = filename:join(Data, "my_code_test2"),
-    Code = filename:join(Priv, "my_code_test2"),
-
-    catch erlang:purge_module(my_code_test2),
-    catch erlang:delete_module(my_code_test2),
-    catch erlang:purge_module(my_code_test2),
-
-    {ok,my_code_test2} = c:c(File, [{outdir,Priv}]),
-
-    T = ets:new(my_code_test2_fun_table, []),
-    ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}),
-    ets:insert(T, {my_fun2,my_code_test2:make_fun2()}),
-
-    spawn(fun () ->
-		  [{my_fun2,F2}] = ets:lookup(T, my_fun2),
-		  F2(fun () ->
-			     receive after infinity -> ok end
-		     end,
-		     fun () -> ok end),
-		  exit(completed)
-	  end),
-
-    PurgeType = case Type of
-		    code_gone ->
-			ok = file:delete(Code++".beam"),
-			true;
-		    code_reload ->
-			true;
-		    code_there ->
-			false
-		end,
-
-    true = erlang:delete_module(my_code_test2),
-
-    Purge = start_purge(my_code_test2, PurgeType),
-
-    {P0, M0} = spawn_monitor(fun () ->
-				     [{my_fun,F}] = ets:lookup(T, my_fun),
-				     4712 = F(1),
-				     exit(completed)
-			     end),
-
-    wait_until(fun () ->
-		       {status, suspended}
-			   == process_info(P0, status)
-	       end),
-
-    ok = continue_purge(Purge),
-
-    {P1, M1} = spawn_monitor(fun () ->
-				     [{my_fun,F}] = ets:lookup(T, my_fun),
-				     4713 = F(2),
-				     exit(completed)
-			     end),
-    {P2, M2} = spawn_monitor(fun () ->
-				     [{my_fun,F}] = ets:lookup(T, my_fun),
-				     4714 = F(3),
-				     exit(completed)
-			     end),
-
-    wait_until(fun () ->
-		       {status, suspended}
-			   == process_info(P1, status)
-	       end),
-    wait_until(fun () ->
-		       {status, suspended}
-			   == process_info(P2, status)
-	       end),
-
-    {current_function,
-     {erts_code_purger,
-      pending_purge_lambda,
-      3}} = process_info(P0, current_function),
-    {current_function,
-     {erts_code_purger,
-      pending_purge_lambda,
-      3}} = process_info(P1, current_function),
-    {current_function,
-     {erts_code_purger,
-      pending_purge_lambda,
-      3}} = process_info(P2, current_function),
-
-    case Type of
-	code_there ->
-	    false = complete_purge(Purge);
-	_ ->
-	    {true, true} = complete_purge(Purge)
-    end,
+    OptsList = case erlang:system_info(hipe_architecture) of
+                   undefined -> [[]];
+                   _ -> [[], [native]]
+               end,
+    [call_purged_fun_test_do(Priv, Data, Type, CO, FO)
+     || CO <- OptsList, FO <- OptsList].
+
+
+call_purged_fun_test_do(Priv, Data, Type, CallerOpts, FunOpts) ->
+    io:format("Compile caller as ~p and funs as ~p\n", [CallerOpts, FunOpts]),
+    SrcFile = filename:join(Data, "call_purged_fun_tester.erl"),
+    ObjFile = filename:join(Priv, "call_purged_fun_tester.beam"),
+    {ok,Mod,Code} = compile:file(SrcFile, [binary, report | CallerOpts]),
+    {module,Mod} = code:load_binary(Mod, ObjFile, Code),
+
+    call_purged_fun_tester:do(Priv, Data, Type, FunOpts).
 
-    case Type of
-	code_gone ->
-	    receive
-		{'DOWN', M0, process, P0, Reason0} ->
-		    {undef, _} = Reason0
-	    end,
-	    receive
-		{'DOWN', M1, process, P1, Reason1} ->
-		    {undef, _} = Reason1
-	    end,
-	    receive
-		{'DOWN', M2, process, P2, Reason2} ->
-		    {undef, _} = Reason2
-	    end;
-	_ ->
-	    receive
-		{'DOWN', M0, process, P0, Reason0} ->
-		    completed = Reason0
-	    end,
-	    receive
-		{'DOWN', M1, process, P1, Reason1} ->
-		    completed = Reason1
-	    end,
-	    receive
-		{'DOWN', M2, process, P2, Reason2} ->
-		    completed = Reason2
-	    end,
-	    catch erlang:purge_module(my_code_test2),
-	    catch erlang:delete_module(my_code_test2),
-	    catch erlang:purge_module(my_code_test2)
-    end,
-    ok.
 
 multi_proc_purge(Config) when is_list(Config) ->
     %%
@@ -975,35 +871,3 @@ flush() ->
 
 id(I) -> I.
 
-wait_until(Fun) ->
-    case Fun() of
-	true ->
-	    ok;
-	false ->
-	    receive after 100 -> ok end,
-	    wait_until(Fun)
-    end.
-
-start_purge(Mod, Type) when is_atom(Mod)
-			    andalso ((Type == true)
-				     orelse (Type == false)) ->
-    Ref = make_ref(),
-    erts_code_purger ! {test_purge, Mod, self(), Type, Ref},
-    receive
-	{started, Ref} ->
-	    Ref
-    end.
-
-continue_purge(Ref) when is_reference(Ref) ->
-    erts_code_purger ! {continue, Ref},
-    receive
-	{continued, Ref} ->
-	    ok
-    end.
-
-complete_purge(Ref) when is_reference(Ref) ->
-    erts_code_purger ! {complete, Ref},
-    receive
-	{test_purge, Res, Ref} ->
-	    Res
-    end.
diff --git a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl
new file mode 100644
index 0000000000..5e031abca8
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl
@@ -0,0 +1,167 @@
+-module(call_purged_fun_tester).
+
+-export([do/4]).
+
+do(Priv, Data, Type, Opts) ->
+    File = filename:join(Data, "my_code_test2"),
+    Code = filename:join(Priv, "my_code_test2"),
+
+    catch erlang:purge_module(my_code_test2),
+    catch erlang:delete_module(my_code_test2),
+    catch erlang:purge_module(my_code_test2),
+
+    {ok,my_code_test2} = c:c(File, [{outdir,Priv} | Opts]),
+
+    IsNative = lists:member(native,Opts),
+    IsNative = code:is_module_native(my_code_test2),
+
+    T = ets:new(my_code_test2_fun_table, []),
+    ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}),
+    ets:insert(T, {my_fun2,my_code_test2:make_fun2()}),
+
+    spawn(fun () ->
+		  [{my_fun2,F2}] = ets:lookup(T, my_fun2),
+		  F2(fun () ->
+			     receive after infinity -> ok end
+		     end,
+		     fun () -> ok end),
+		  exit(completed)
+	  end),
+
+    PurgeType = case Type of
+		    code_gone ->
+			ok = file:delete(Code++".beam"),
+			true;
+		    code_reload ->
+			true;
+		    code_there ->
+			false
+		end,
+
+    true = erlang:delete_module(my_code_test2),
+
+    Purge = start_purge(my_code_test2, PurgeType),
+
+    {P0, M0} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4712 = F(1),
+				     exit(completed)
+			     end),
+
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P0, status)
+	       end),
+
+    ok = continue_purge(Purge),
+
+    {P1, M1} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4713 = F(2),
+				     exit(completed)
+			     end),
+    {P2, M2} = spawn_monitor(fun () ->
+				     [{my_fun,F}] = ets:lookup(T, my_fun),
+				     4714 = F(3),
+				     exit(completed)
+			     end),
+
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P1, status)
+	       end),
+    wait_until(fun () ->
+		       {status, suspended}
+			   == process_info(P2, status)
+	       end),
+
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P0, current_function),
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P1, current_function),
+    {current_function,
+     {erts_code_purger,
+      pending_purge_lambda,
+      3}} = process_info(P2, current_function),
+
+    case Type of
+	code_there ->
+	    false = complete_purge(Purge);
+	_ ->
+	    {true, true} = complete_purge(Purge)
+    end,
+
+    case Type of
+	code_gone ->
+	    receive
+		{'DOWN', M0, process, P0, Reason0} ->
+		    {undef, _} = Reason0
+	    end,
+	    receive
+		{'DOWN', M1, process, P1, Reason1} ->
+		    {undef, _} = Reason1
+	    end,
+	    receive
+		{'DOWN', M2, process, P2, Reason2} ->
+		    {undef, _} = Reason2
+	    end;
+	_ ->
+	    receive
+		{'DOWN', M0, process, P0, Reason0} ->
+		    completed = Reason0
+	    end,
+	    receive
+		{'DOWN', M1, process, P1, Reason1} ->
+		    completed = Reason1
+	    end,
+	    receive
+		{'DOWN', M2, process, P2, Reason2} ->
+		    completed = Reason2
+	    end,
+	    catch erlang:purge_module(my_code_test2),
+	    catch erlang:delete_module(my_code_test2),
+	    catch erlang:purge_module(my_code_test2)
+    end,
+    ok.
+
+wait_until(Fun) ->
+    ok = wait_until(Fun, 20).
+
+wait_until(Fun, N) ->
+    case {Fun(),N} of
+	{true, _} ->
+	    ok;
+        {false, 0} ->
+            timeout;
+	{false, _} ->
+	    receive after 100 -> ok end,
+	    wait_until(Fun, N-1)
+    end.
+
+start_purge(Mod, Type) when is_atom(Mod)
+			    andalso ((Type == true)
+				     orelse (Type == false)) ->
+    Ref = make_ref(),
+    erts_code_purger ! {test_purge, Mod, self(), Type, Ref},
+    receive
+	{started, Ref} ->
+	    Ref
+    end.
+
+continue_purge(Ref) when is_reference(Ref) ->
+    erts_code_purger ! {continue, Ref},
+    receive
+	{continued, Ref} ->
+	    ok
+    end.
+
+complete_purge(Ref) when is_reference(Ref) ->
+    erts_code_purger ! {complete, Ref},
+    receive
+	{test_purge, Res, Ref} ->
+	    Res
+    end.