Merge branch 'maint'

* maint:
  Fix tracing of processes executing dirty
  Perform check_process_code while process is executing dirty
  Fix purge of code
  Reclaim literal area after purge has completed
  Separate literal area from code

Conflicts:
	erts/emulator/beam/global.h

5 files changed, 374 insertions, 15 deletions

diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 2347a3d4ef..34515efa3d 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -20,7 +20,8 @@
 
 -module(code_SUITE).
 -export([all/0, suite/0, init_per_suite/1, end_per_suite/1, 
-         versions/1,new_binary_types/1,
+         versions/1,new_binary_types/1, call_purged_fun_code_gone/1,
+	 call_purged_fun_code_reload/1, call_purged_fun_code_there/1,
          t_check_process_code/1,t_check_old_code/1,
          t_check_process_code_ets/1,
          external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
@@ -34,7 +35,8 @@
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
-    [versions, new_binary_types, t_check_process_code,
+    [versions, new_binary_types, call_purged_fun_code_gone,
+     call_purged_fun_code_reload, call_purged_fun_code_there, t_check_process_code,
      t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
      module_md5, make_stub, make_stub_many_funs,
      constant_pools, constant_refc_binaries, false_dependency,
@@ -127,12 +129,169 @@ new_binary_types(Config) when is_list(Config) ->
                                                     bit_sized_binary(Bin))),
     ok.
 
+call_purged_fun_code_gone(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    call_purged_fun_test(Priv, Data, code_gone),
+    ok.
+
+call_purged_fun_code_reload(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    Path = code:get_path(),
+    true = code:add_path(Priv),
+    try
+	call_purged_fun_test(Priv, Data, code_reload)
+    after
+	code:set_path(Path)
+    end,
+    ok.
+
+call_purged_fun_code_there(Config) when is_list(Config) ->
+    Priv = proplists:get_value(priv_dir, Config),
+    Data = proplists:get_value(data_dir, Config),
+    call_purged_fun_test(Priv, Data, code_there),
+    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,
+
+    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.
+
 t_check_process_code(Config) when is_list(Config) ->
+    case check_process_code_handle(indirect_references) of
+	false -> {skipped, "check_process_code() ignores funs"};
+	true -> t_check_process_code_test(Config)
+    end.
+
+t_check_process_code_test(Config) ->
     Priv = proplists:get_value(priv_dir, Config),
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
     Code = filename:join(Priv, "my_code_test"),
 
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+
     {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
 
     MyFun = fun(X, Y) -> X + Y end,	%Confuse things.
@@ -231,11 +390,16 @@ gc1() -> ok.
 
 %% Test check_process_code/2 in combination with a fun obtained from an ets table.
 t_check_process_code_ets(Config) when is_list(Config) ->
-    case test_server:is_native(?MODULE) of
-        true ->
-            {skip,"Native code"};
-        false ->
-            do_check_process_code_ets(Config)
+    case check_process_code_handle(indirect_references) of
+	false ->
+	    {skipped, "check_process_code() ignores funs"};
+	true ->
+	    case test_server:is_native(?MODULE) of
+		true ->
+		    {skip,"Native code"};
+		false ->
+		    do_check_process_code_ets(Config)
+	    end
     end.
 
 do_check_process_code_ets(Config) ->
@@ -243,8 +407,9 @@ do_check_process_code_ets(Config) ->
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
 
-    erlang:purge_module(my_code_test),
-    erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
     {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
 
     T = ets:new(my_code_test, []),
@@ -295,8 +460,8 @@ t_check_old_code(Config) when is_list(Config) ->
     Data = proplists:get_value(data_dir, Config),
     File = filename:join(Data, "my_code_test"),
 
-    erlang:purge_module(my_code_test),
-    erlang:delete_module(my_code_test),
+    catch erlang:purge_module(my_code_test),
+    catch erlang:delete_module(my_code_test),
     catch erlang:purge_module(my_code_test),
 
     false = erlang:check_old_code(my_code_test),
@@ -971,3 +1136,39 @@ flush() ->
     receive _ -> flush() after 0 -> ok end.
 
 id(I) -> I.
+
+check_process_code_handle(What) ->
+    lists:member(What, erlang:system_info(check_process_code)).
+
+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/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl
index d2386157d6..9d12aa9897 100644
--- a/erts/emulator/test/code_SUITE_data/my_code_test.erl
+++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl
@@ -24,5 +24,3 @@
 
 make_fun(A) ->
     fun(X) -> A + X end.
-
-	    
diff --git a/erts/emulator/test/code_SUITE_data/my_code_test2.erl b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
new file mode 100644
index 0000000000..57973535d4
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% 
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(my_code_test2).
+
+-export([make_fun/1, make_fun2/0]).
+
+make_fun(A) ->
+    fun(X) -> A + X end.
+
+make_fun2() ->
+    fun (F1,F2) ->
+	    F1(),
+	    F2()
+    end.
diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl
index 83b098a704..653b96557e 100644
--- a/erts/emulator/test/dirty_nif_SUITE.erl
+++ b/erts/emulator/test/dirty_nif_SUITE.erl
@@ -33,7 +33,8 @@
 	 dirty_nif_exception/1, call_dirty_nif_exception/1,
 	 dirty_scheduler_exit/1, dirty_call_while_terminated/1,
 	 dirty_heap_access/1, dirty_process_info/1,
-	 dirty_process_register/1, dirty_process_trace/1]).
+	 dirty_process_register/1, dirty_process_trace/1,
+	 code_purge/1, dirty_nif_send_traced/1]).
 
 -define(nif_stub,nif_stub_error(?LINE)).
 
@@ -48,7 +49,9 @@ all() ->
      dirty_heap_access,
      dirty_process_info,
      dirty_process_register,
-     dirty_process_trace].
+     dirty_process_trace,
+     code_purge,
+     dirty_nif_send_traced].
 
 init_per_suite(Config) ->
     try erlang:system_info(dirty_cpu_schedulers) of
@@ -349,6 +352,103 @@ dirty_process_trace(Config) when is_list(Config) ->
 	      ok
       end).
 
+dirty_code_test_code() ->
+    "
+-module(dirty_code_test).
+
+-export([func/1]).
+
+func(Fun) ->
+  Fun(),
+  blipp:blapp().
+
+".
+
+code_purge(Config) when is_list(Config) ->
+    Path = ?config(data_dir, Config),
+    File = filename:join(Path, "dirty_code_test.erl"),
+    ok = file:write_file(File, dirty_code_test_code()),
+    {ok, dirty_code_test, Bin} = compile:file(File, [binary]),
+    {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+    Start = erlang:monotonic_time(),
+    {Pid1, Mon1} = spawn_monitor(fun () ->
+				       dirty_code_test:func(fun () ->
+								    %% Sleep for 6 seconds
+								    %% in dirty nif...
+								    dirty_sleeper()
+							    end)
+			       end),
+    {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+    {Pid2, Mon2} = spawn_monitor(fun () ->
+				       dirty_code_test:func(fun () ->
+								    %% Sleep for 6 seconds
+								    %% in dirty nif...
+								    dirty_sleeper()
+							    end)
+				 end),
+    receive
+	{'DOWN', Mon1, process, Pid1, _} ->
+	    ct:fail(premature_death)
+    after 100 ->
+	    ok
+    end,
+    true = erlang:purge_module(dirty_code_test),
+    receive
+	{'DOWN', Mon1, process, Pid1, Reason1} ->
+	    killed = Reason1
+    end,
+    receive
+	{'DOWN', Mon2, process, Pid2, _} ->
+	    ct:fail(premature_death)
+    after 100 ->
+	    ok
+    end,
+    true = erlang:delete_module(dirty_code_test),
+    receive
+	{'DOWN', Mon2, process, Pid2, _} ->
+	    ct:fail(premature_death)
+    after 100 ->
+	    ok
+    end,
+    true = erlang:purge_module(dirty_code_test),
+    receive
+	{'DOWN', Mon2, process, Pid2, Reason2} ->
+	    killed = Reason2
+    end,
+    End = erlang:monotonic_time(),
+    Time = erlang:convert_time_unit(End-Start, native, milli_seconds),
+    io:format("Time=~p~n", [Time]),
+    true = Time =< 1000,
+    ok.
+
+dirty_nif_send_traced(Config) when is_list(Config) ->
+    Parent = self(),
+    Rcvr = spawn_link(fun() ->
+			      Self = self(),
+			      receive {ok, Self} -> ok end,
+			      Parent ! {Self, received}
+		      end),
+    Sndr = spawn_link(fun () ->
+			      receive {Parent, go} -> ok end,
+			      {ok, Rcvr} = send_wait_from_dirty_nif(Rcvr),
+			      Parent ! {self(), sent}
+		      end),
+    1 = erlang:trace(Sndr, true, [send]),
+    Start = erlang:monotonic_time(),
+    Sndr ! {self(), go},
+    receive {trace, Sndr, send, {ok, Rcvr}, Rcvr} -> ok end,
+    receive {Rcvr, received} -> ok end,
+    End1 = erlang:monotonic_time(),
+    Time1 = erlang:convert_time_unit(End1-Start, native, 1000),
+    io:format("Time1: ~p milliseconds~n", [Time1]),
+    true = Time1 < 500,
+    receive {Sndr, sent} -> ok end,
+    End2 = erlang:monotonic_time(),
+    Time2 = erlang:convert_time_unit(End2-Start, native, 1000),
+    io:format("Time2: ~p milliseconds~n", [Time2]),
+    true = Time2 >= 1900,
+    ok.
+
 %%
 %% Internal...
 %%
@@ -431,6 +531,7 @@ mcall(Node, Funs) ->
 lib_loaded() -> false.
 call_dirty_nif(_,_,_) -> ?nif_stub.
 send_from_dirty_nif(_) -> ?nif_stub.
+send_wait_from_dirty_nif(_) -> ?nif_stub.
 call_dirty_nif_exception(_) -> ?nif_stub.
 call_dirty_nif_zero_args() -> ?nif_stub.
 dirty_call_while_terminated_nif(_) -> ?nif_stub.
diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
index d92933a096..a0019e5d95 100644
--- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
+++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
@@ -100,6 +100,32 @@ static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_
 	return result;
 }
 
+static ERL_NIF_TERM send_wait_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+    ERL_NIF_TERM result;
+    ErlNifPid pid;
+    ErlNifEnv* menv;
+    int res;
+
+    if (!enif_get_local_pid(env, argv[0], &pid))
+	return enif_make_badarg(env);
+    result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
+    menv = enif_alloc_env();
+    res = enif_send(env, &pid, menv, result);
+    enif_free_env(menv);
+
+#ifdef __WIN32__
+    Sleep(2000);
+#else
+    sleep(2);
+#endif
+
+    if (!res)
+	return enif_make_badarg(env);
+    else
+	return result;
+}
+
 static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     switch (argc) {
@@ -237,6 +263,7 @@ static ErlNifFunc nif_funcs[] =
     {"lib_loaded", 0, lib_loaded},
     {"call_dirty_nif", 3, call_dirty_nif},
     {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+    {"send_wait_from_dirty_nif", 1, send_wait_from_dirty_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
     {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND},
     {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND},
     {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND},