From 23362aeb8f364adb64a0825ea40dcb1158babe13 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 22 Apr 2010 09:15:45 +0200
Subject: gen: Inline wait_resp_mon/2 to help the compiler optimize

We are about to introduce a new optimization that requires
the creation of a monitor and the following receive statement
to be in the same function.
---
 lib/stdlib/src/gen.erl | 35 ++++++++++++++++-------------------
 1 file changed, 16 insertions(+), 19 deletions(-)

(limited to 'lib')

diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 5aab547644..30f48d39b7 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -212,7 +212,22 @@ do_call(Process, Label, Request, Timeout) ->
 
 	    catch erlang:send(Process, {Label, {self(), Mref}, Request},
 		  [noconnect]),
-	    wait_resp_mon(Node, Mref, Timeout)
+	    receive
+		{Mref, Reply} ->
+		    erlang:demonitor(Mref, [flush]),
+		    {ok, Reply};
+		{'DOWN', Mref, _, _, noconnection} ->
+		    exit({nodedown, Node});
+		{'DOWN', Mref, _, _, Reason} ->
+		    exit(Reason)
+	    after Timeout ->
+		    erlang:demonitor(Mref),
+		    receive
+			{'DOWN', Mref, _, _, _} -> true
+		    after 0 -> true
+		    end,
+		    exit(timeout)
+	    end
     catch
 	error:_ ->
 	    %% Node (C/Java?) is not supporting the monitor.
@@ -233,24 +248,6 @@ do_call(Process, Label, Request, Timeout) ->
 	    end
     end.
 
-wait_resp_mon(Node, Mref, Timeout) ->
-    receive
-	{Mref, Reply} ->
-	    erlang:demonitor(Mref, [flush]),
-	    {ok, Reply};
-	{'DOWN', Mref, _, _, noconnection} ->
-	    exit({nodedown, Node});
-	{'DOWN', Mref, _, _, Reason} ->
-	    exit(Reason)
-    after Timeout ->
-	    erlang:demonitor(Mref),
-	    receive
-		{'DOWN', Mref, _, _, _} -> true 
-	    after 0 -> true
-	    end,
-	    exit(timeout)
-    end.
-
 wait_resp(Node, Tag, Timeout) ->
     receive
 	{Tag, Reply} ->
-- 
cgit v1.2.3


From f0d8728a851901e9080eb35aee0b6b8e24b2d91e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 22 Apr 2010 13:39:30 +0200
Subject: Move p_run/2 to test_lib

It can be useful for other test suites.
---
 lib/compiler/test/compile_SUITE.erl | 36 ++----------------------------------
 lib/compiler/test/test_lib.erl      | 34 +++++++++++++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 35 deletions(-)

(limited to 'lib')

diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 7c3990a855..bba0d3fb48 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -625,7 +625,7 @@ core(Config) when is_list(Config) ->
 				    {raw_abstract_v1,Abstr}}]}} = 
 			     beam_lib:chunks(Beam, [abstract_code]),
 			 {Mod,Abstr} end || Beam <- TestBeams],
-    ?line Res = p_run(fun(F) -> do_core(F, Outdir) end, Abstr),
+    ?line Res = test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr),
     ?line test_server:timetrap_cancel(Dog),
     Res.
 
@@ -661,7 +661,7 @@ asm(Config) when is_list(Config) ->
 
     ?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
     ?line TestBeams = filelib:wildcard(Wc),
-    ?line Res = p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams),
+    ?line Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams),
     ?line test_server:timetrap_cancel(Dog),
     Res.
 
@@ -688,35 +688,3 @@ do_asm(Beam, Outdir) ->
 		      [M,Class,Error,erlang:get_stacktrace()]),
 	    error
     end.
-    
-%% p_run(fun() -> ok|error, List) -> ok
-%%  Will fail the test case if there were any errors.
-
-p_run(Test, List) ->
-    N = erlang:system_info(schedulers) + 1,
-    p_run_loop(Test, List, N, [], 0, 0).
-
-p_run_loop(_, [], _, [], Errors, Ws) ->
-    case Errors of
-	0 ->
-	    case Ws of
-		0 -> ok;
-		1 -> {comment,"1 core_lint failure"};
-		N -> {comment,integer_to_list(N)++" core_lint failures"}
-	    end;
-	N -> ?t:fail({N,errors})
-    end;
-p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N ->
-    {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
-    p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws);
-p_run_loop(Test, List, N, Refs0, Errors0, Ws0) ->
-    receive
-	{'DOWN',Ref,process,_,Res} ->
-	    {Errors,Ws} = case Res of
-			      ok -> {Errors0,Ws0};
-			      error -> {Errors0+1,Ws0};
-			      warning -> {Errors0,Ws0+1}
-			  end,
-	    Refs = Refs0 -- [Ref],
-	    p_run_loop(Test, List, N, Refs, Errors, Ws)
-    end.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 844bbfc4b9..05236ee010 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -20,7 +20,7 @@
 
 -include("test_server.hrl").
 
--export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1]).
+-export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1,p_run/2]).
 
 recompile(Mod) when is_atom(Mod) ->
     case whereis(cover_server) of
@@ -72,3 +72,35 @@ get_data_dir(Config) ->
     {ok,Data2,_} = regexp:sub(Data1, "_post_opt_SUITE", "_SUITE"),
     {ok,Data,_} = regexp:sub(Data2, "_inline_SUITE", "_SUITE"),
     Data.
+
+%% p_run(fun(Data) -> ok|error, List) -> ok
+%%  Will fail the test case if there were any errors.
+
+p_run(Test, List) ->
+    N = erlang:system_info(schedulers) + 1,
+    p_run_loop(Test, List, N, [], 0, 0).
+
+p_run_loop(_, [], _, [], Errors, Ws) ->
+    case Errors of
+	0 ->
+	    case Ws of
+		0 -> ok;
+		1 -> {comment,"1 warning"};
+		N -> {comment,integer_to_list(N)++" warnings"}
+	    end;
+	N -> ?t:fail({N,errors})
+    end;
+p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N ->
+    {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
+    p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws);
+p_run_loop(Test, List, N, Refs0, Errors0, Ws0) ->
+    receive
+	{'DOWN',Ref,process,_,Res} ->
+	    {Errors,Ws} = case Res of
+			      ok -> {Errors0,Ws0};
+			      error -> {Errors0+1,Ws0};
+			      warning -> {Errors0,Ws0+1}
+			  end,
+	    Refs = Refs0 -- [Ref],
+	    p_run_loop(Test, List, N, Refs, Errors, Ws)
+    end.
-- 
cgit v1.2.3


From ea0f50dfbc8ec99820b81f99be81ada727bb3cf8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Tue, 11 May 2010 08:42:25 +0200
Subject: Compile tests that communicate with R12 nodes with the r12 option

R12 nodes cannot load code that use the optimized receive that
we are about to implement.
---
 lib/stdlib/test/io_proto_SUITE.erl       | 1 +
 lib/stdlib/test/qlc_SUITE.erl            | 1 +
 lib/test_server/src/test_server_node.erl | 1 +
 3 files changed, 3 insertions(+)

(limited to 'lib')

diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index 93159fbd5b..d9672a8c7b 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -17,6 +17,7 @@
 %% %CopyrightEnd%
 %%
 -module(io_proto_SUITE).
+-compile(r12).
 
 -export([all/1]).
 
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index ff11ebc6bf..ec014052f4 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -20,6 +20,7 @@
 %%% Purpose:Test Suite for the 'qlc' module.
 %%%-----------------------------------------------------------------
 -module(qlc_SUITE).
+-compile(r12).
 
 -define(QLC, qlc).
 -define(QLCs, "qlc").
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 32886b6765..49025b1a3d 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -17,6 +17,7 @@
 %% %CopyrightEnd%
 %%
 -module(test_server_node).
+-compile(r12).
 
 %%%
 %%% The same compiled code for this module must be possible to load
-- 
cgit v1.2.3


From d60f055697cfe8e7f94be4d291d49bb00a66bc52 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 22 Apr 2010 15:18:13 +0200
Subject: Introduce the new recv_mark/1 and recv_mark/1 instructions

Make the recv_mark/1 and recv_mark/1 instructions known to the
compiler and run-time system. For the moment, make the loader ignore
any occurrences of those instructions in BEAM files.

Also update hipe_beam_to_icode to ignore those instructions.
---
 lib/compiler/src/beam_disasm.erl      | 8 ++++++++
 lib/compiler/src/beam_validator.erl   | 5 +++++
 lib/compiler/src/genop.tab            | 5 +++++
 lib/hipe/icode/hipe_beam_to_icode.erl | 5 +++++
 4 files changed, 23 insertions(+)

(limited to 'lib')

diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c956f2f000..a66bd2a23a 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1095,6 +1095,14 @@ resolve_inst({bs_put_utf32=I,[Lbl,{u,U},Arg3]},_,_,_) ->
 resolve_inst({on_load,[]},_,_,_) ->
     on_load;
 
+%%
+%% R14A.
+%%
+resolve_inst({recv_mark,[Lbl]},_,_,_) ->
+    {recv_mark,Lbl};
+resolve_inst({recv_set,[Lbl]},_,_,_) ->
+    {recv_set,Lbl};
+
 %%
 %% Catches instructions that are not yet handled.
 %%
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 1fd61831e0..34065cfdce 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -416,6 +416,11 @@ valfun_1({put,Src}, Vst) ->
 valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) ->
     Vst = eat_heap(2*Sz, Vst0),
     set_type_reg(cons, Dst, Vst);
+%% Instructions for optimization of selective receives.
+valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
+    Vst;
+valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) ->
+    Vst;
 %% Misc.
 valfun_1({'%live',Live}, Vst) ->
     verify_live(Live, Vst),
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 47e6e72402..b57508ea8e 100644
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -274,3 +274,8 @@ BEAM_FORMAT_NUMBER=0
 # R13B03
 
 149: on_load/0
+
+# R14A
+
+150: recv_mark/1
+151: recv_set/1
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 3923e98673..f24cf90ae2 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -431,6 +431,11 @@ trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) ->
   SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[],
 			       map_label(Lbl),hipe_icode:label_name(DoneLbl)),
   Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)];
+%%--- mark_recv/1 & mark_set/1 ---
+trans_fun([{mark_recv,{f,_}}|Instructions], Env) ->
+  trans_fun(Instructions,Env);
+trans_fun([{mark_set,{f,_}}|Instructions], Env) ->
+  trans_fun(Instructions,Env);
 %%--------------------------------------------------------------------
 %%--- Translation of arithmetics {bif,ArithOp, ...} ---
 %%--------------------------------------------------------------------
-- 
cgit v1.2.3


From 1d3148a8532b9319265fbe4107cdde81b554b3a2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 22 Apr 2010 10:07:18 +0200
Subject: Optimize selective receives in the presence of a large message queue

If a gen_server process has many messages in its message queue and
calls another gen_server process, the selective receive in
gen_server:call() will have to go through the entire message queue.

Have the compiler generate the new mark_recv/1 and mark_recv/1
instructions that can avoid going through the entire message queue.
---
 lib/compiler/src/Makefile         |   1 +
 lib/compiler/src/beam_receive.erl | 388 ++++++++++++++++++++++++++++++++++++++
 lib/compiler/src/compile.erl      |   6 +
 lib/compiler/src/compiler.app.src |   1 +
 4 files changed, 396 insertions(+)
 create mode 100644 lib/compiler/src/beam_receive.erl

(limited to 'lib')

diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 70ddd54145..0f6d2f6193 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -58,6 +58,7 @@ MODULES =  \
 	beam_listing \
 	beam_opcodes \
 	beam_peep \
+	beam_receive \
 	beam_trim \
 	beam_type \
 	beam_utils \
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
new file mode 100644
index 0000000000..9ed44ad5d7
--- /dev/null
+++ b/lib/compiler/src/beam_receive.erl
@@ -0,0 +1,388 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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(beam_receive).
+-export([module/2]).
+-import(lists, [foldl/3,reverse/1,reverse/2]).
+
+%%%
+%%% In code such as:
+%%%
+%%%    Ref = make_ref(),        %Or erlang:monitor(process, Pid)
+%%%      .
+%%%      .
+%%%      .
+%%%    receive
+%%%       {Ref,Reply} -> Reply
+%%%    end.
+%%%
+%%% we know that none of the messages that exist in the message queue
+%%% before the call to make_ref/0 can be matched out in the receive
+%%% statement. Therefore we can avoid going through the entire message
+%%% queue if we introduce two new instructions (here written as
+%%% BIFs in pseudo-Erlang):
+%%%
+%%%    recv_mark(SomeUniqInteger),
+%%%    Ref = make_ref(),
+%%%      .
+%%%      .
+%%%      .
+%%%    recv_set(SomeUniqInteger),
+%%%    receive
+%%%       {Ref,Reply} -> Reply
+%%%    end.
+%%%
+%%% The recv_mark/1 instruction will save the current position and
+%%% SomeUniqInteger in the process context. The recv_set
+%%% instruction will verify that SomeUniqInteger is still stored
+%%% in the process context. If it is, it will set the current pointer
+%%% for the message queue (the next message to be read out) to the
+%%% position that was saved by recv_mark/1.
+%%%
+%%% The remove_message instruction must be modified to invalidate
+%%% the information stored by the previous recv_mark/1, in case there
+%%% is another receive executed between the calls to recv_mark/1 and
+%%% recv_set/1.
+%%%
+%%% We use a reference to a label (i.e. a position in the loaded code)
+%%% as the SomeUniqInteger.
+%%%
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
+    Fs = [function(F) || F <- Fs0],
+    Code = {Mod,Exp,Attr,Fs,Lc},
+    {ok,Code}.
+
+%%%
+%%% Local functions.
+%%%
+
+function({function,Name,Arity,Entry,Is}) ->
+    try
+	D = beam_utils:index_labels(Is),
+	{function,Name,Arity,Entry,opt(Is, D, [])}
+    catch
+	Class:Error ->
+	    Stack = erlang:get_stacktrace(),
+	    io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+	    erlang:raise(Class, Error, Stack)
+    end.
+
+opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) ->
+    case creates_new_ref(Name, Arity) of
+	true ->
+	    %% The call creates a brand new reference. Now
+	    %% search for a receive statement in the same
+	    %% function that will match against the reference.
+	    case opt_recv(Is0, D) of
+		no ->
+		    opt(Is0, D, [I|Acc]);
+		{yes,Is,Lbl} ->
+		    opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc])
+	    end;
+	false ->
+	    opt(Is0, D, [I|Acc])
+    end;
+opt([I|Is], D, Acc) ->
+    opt(Is, D, [I|Acc]);
+opt([], _, Acc) ->
+    reverse(Acc).
+
+%% creates_new_ref(Name, Arity) -> true|false.
+%%  Return 'true' if the BIF Name/Arity will create a new reference.
+creates_new_ref(monitor, 2) -> true;
+creates_new_ref(make_ref, 0) -> true;
+creates_new_ref(_, _) -> false.
+
+%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]}
+%%  Search for a receive statement that will only retrieve messages
+%%  that contain the newly created reference (which is currently in {x,0}).
+opt_recv(Is, D) ->
+    R = regs_init_x0(),
+    L = gb_sets:empty(),
+    opt_recv(Is, D, R, L, []).
+
+opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) ->
+    R = regs_kill_not_live(0, R0),
+    case regs_to_list(R) of
+	[{y,_}=RefReg] ->
+	    %% We now have the new reference in the Y register RefReg
+	    %% and the current instruction is the beginning of a
+	    %% receive statement. We must now verify that only messages
+	    %% that contain the reference will be matched.
+	    case opt_ref_used(Is, RefReg, Fail, D) of
+		false ->
+		    no;
+		true ->
+		    RecvSet = {recv_set,{f,L}},
+		    {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L}
+	    end;
+	[] ->
+	    no
+    end;
+opt_recv([I|Is], D, R0, L0, Acc) ->
+    {R,L} = opt_update_regs(I, R0, L0),
+    case regs_empty(R) of
+	true ->
+	    %% The reference is no longer alive. There is no
+	    %% point in continuing the search.
+	    no;
+	false ->
+	    opt_recv(Is, D, R, L, [I|Acc])
+    end.
+
+opt_update_regs({block,Bl}, R, L) ->
+    {opt_update_regs_bl(Bl, R),L};
+opt_update_regs({call,_,_}, R, L) ->
+    {regs_kill_not_live(0, R),L};
+opt_update_regs({call_ext,_,_}, R, L) ->
+    {regs_kill_not_live(0, R),L};
+opt_update_regs({call_fun,_}, R, L) ->
+    {regs_kill_not_live(0, R),L};
+opt_update_regs({kill,Y}, R, L) ->
+    {regs_kill([Y], R),L};
+opt_update_regs(send, R, L) ->
+    {regs_kill_not_live(0, R),L};
+opt_update_regs({'catch',_,{f,Lbl}}, R, L) ->
+    {R,gb_sets:add(Lbl, L)};
+opt_update_regs({catch_end,_}, R, L) ->
+    {R,L};
+opt_update_regs({label,Lbl}, R, L) ->
+    case gb_sets:is_member(Lbl, L) of
+	false ->
+	    %% We can't allow arbitrary labels (since the receive
+	    %% could be entered without first creating the reference).
+	    {regs_init(),L};
+	true ->
+	    %% A catch label for a previously seen catch instruction is OK.
+	    {R,L}
+    end;
+opt_update_regs({try_end,_}, R, L) ->
+    {R,L};
+opt_update_regs(_I, _R, L) ->
+    %% Unrecognized instruction. Abort the search.
+    {regs_init(),L}.
+
+opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) ->
+    Regs1 = regs_kill_not_live(Live, Regs0),
+    Regs = regs_kill(Ds, Regs1),
+    opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) ->
+    Regs1 = regs_kill(Ds, Regs0),
+    Regs = case regs_is_member(Src, Regs1) of
+	       false -> Regs1;
+	       true -> regs_add(Dst, Regs1)
+	   end,
+    opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) ->
+    Regs = regs_kill(Ds, Regs0),
+    opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([], Regs) -> Regs.
+
+%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false
+%%  Return 'true' if it is certain that only messages that contain the same
+%%  reference as in RefRegister can be matched out. Otherwise return 'false'.
+%%
+%%  Basically, we follow all possible paths through the receive statement.
+%%  If all paths are safe, we return 'true'.
+%%
+%%  A branch to FailLabel is safe, because it exits the receive statement
+%%  and no further message may be matched out.
+%%
+%%  If a path hits an comparision between RefRegister and part of the message,
+%%  that path is safe (any messages that may be matched further down the
+%%  path is guaranteed to contain the reference).
+%%
+%%  Otherwise, if we hit a 'remove_message' instruction, we give up
+%%  and return 'false' (the optimization is definitely unsafe). If
+%%  we hit an unrecognized instruction, we also give up and return
+%%  'false' (the optimization may be unsafe).
+
+opt_ref_used(Is, RefReg, Fail, D) ->
+    Done = gb_sets:singleton(Fail),
+    Regs = regs_init_x0(),
+    try
+	opt_ref_used_1(Is, RefReg, D, Done, Regs),
+	true
+    catch
+	throw:not_used ->
+	    false
+    end.
+
+%% This functions only returns if all paths through the receive
+%% statement are safe, and throws an 'not_used' term otherwise.
+opt_ref_used_1([{block,Bl}|Is], RefReg, D, Done, Regs0) ->
+    Regs = opt_ref_used_bl(Bl, Regs0),
+    opt_ref_used_1(Is, RefReg, D, Done, Regs);
+opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) ->
+    Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs),
+    case is_ref_msg_comparison(Args, RefReg, Regs) of
+	false ->
+	    opt_ref_used_1(Is, RefReg, D, Done, Regs);
+	true ->
+	    %% The instructions that follow (Is) can only be executed
+	    %% if the message contains the same reference as in RefReg.
+	    Done
+    end;
+opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) ->
+    Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs),
+    case is_ref_msg_comparison(Args, RefReg, Regs) of
+	false ->
+	    opt_ref_used_at(Fail, RefReg, D, Done, Regs);
+	true ->
+	    Done
+    end;
+opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) ->
+    Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs),
+    opt_ref_used_1(Is, RefReg, D, Done, Regs);
+opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) ->
+    Lbls = [F || {f,F} <- List] ++ [Fail],
+    opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs);
+opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) ->
+    Lbls = [F || {f,F} <- List] ++ [Fail],
+    opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs);
+opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) ->
+    case gb_sets:is_member(Lbl, Done) of
+	true -> Done;
+	false -> opt_ref_used_1(Is, RefReg, D, Done, Regs)
+    end;
+opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) ->
+    Done;
+opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) ->
+    %% The optimization may be unsafe.
+    throw(not_used).
+
+%% is_ref_msg_comparison(Args, RefReg, RegisterSet) -> true|false.
+%%  Return 'true' if Args denotes a comparison between the
+%%  reference and message or part of the message.
+is_ref_msg_comparison([R,RefReg], RefReg, Regs) ->
+    regs_is_member(R, Regs);
+is_ref_msg_comparison([RefReg,R], RefReg, Regs) ->
+    regs_is_member(R, Regs);
+is_ref_msg_comparison([_,_], _, _) -> false.
+
+opt_ref_used_in_all([L|Ls], RefReg, D, Done0, Regs) ->
+    Done = opt_ref_used_at(L, RefReg, D, Done0, Regs),
+    opt_ref_used_in_all(Ls, RefReg, D, Done, Regs);
+opt_ref_used_in_all([], _, _, Done, _) -> Done.
+
+opt_ref_used_at(Fail, RefReg, D, Done0, Regs) ->
+    case gb_sets:is_member(Fail, Done0) of
+	true ->
+	    Done0;
+	false ->
+	    Is = beam_utils:code_at(Fail, D),
+	    Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs),
+	    gb_sets:add(Fail, Done)
+    end.
+
+opt_ref_used_bl([{set,[],[],remove_message}|_], _) ->
+    %% We have proved that a message that does not depend on the
+    %% reference can be matched out.
+    throw(not_used);
+opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) ->
+    case regs_all_members(Ss, Regs0) of
+	false ->
+	    %% The destination registers may be assigned values that
+	    %% are not dependent on the message being matched.
+	    Regs = regs_kill(Ds, Regs0),
+	    opt_ref_used_bl(Is, Regs);
+	true ->
+	    %% All the sources depend on the message directly or
+	    %% indirectly.
+	    Regs = regs_add_list(Ds, Regs0),
+	    opt_ref_used_bl(Is, Regs)
+    end;
+opt_ref_used_bl([], Regs) -> Regs.
+
+%%%
+%%% Functions for keeping track of a set of registers.
+%%%
+
+%% regs_init() -> RegisterSet
+%%  Return an empty set of registers.
+
+regs_init() ->
+    {0,0}.
+
+%% regs_init_x0() -> RegisterSet
+%%  Return a set that only contains the {x,0} register.
+
+regs_init_x0() ->
+    {1 bsl 0,0}.
+
+%% regs_empty(Register) -> true|false
+%%  Test whether the register set is empty.
+
+regs_empty(R) ->
+    R =:= {0,0}.
+
+%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet'
+%%  Kill all registers indicated not live by Live.
+
+regs_kill_not_live(Live, {Xregs,Yregs}) ->
+    {Xregs band ((1 bsl Live)-1),Yregs}.
+
+%% regs_kill([Register], RegisterSet) -> RegisterSet'
+%%  Kill all registers mentioned in the list of registers.
+
+regs_kill([{x,N}|Rs], {Xregs,Yregs}) ->
+    regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs});
+regs_kill([{y,N}|Rs], {Xregs,Yregs}) ->
+    regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))});
+regs_kill([{fr,_}|Rs], Regs) ->
+    regs_kill(Rs, Regs);
+regs_kill([], Regs) -> Regs.
+
+regs_add_list(List, Regs) ->
+    foldl(fun(R, A) -> regs_add(R, A) end, Regs, List).
+
+%% regs_add(Register, RegisterSet) -> RegisterSet'
+%%  Add a new register to the set of registers.
+
+regs_add({x,N}, {Xregs,Yregs}) ->
+    {Xregs bor (1 bsl N),Yregs};
+regs_add({y,N}, {Xregs,Yregs}) ->
+    {Xregs,Yregs bor (1 bsl N)}.
+
+%% regs_all_members([Register], RegisterSet) -> true|false
+%%  Test whether all of the registers are part of the register set.
+
+regs_all_members([R|Rs], Regs) ->
+    regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs);
+regs_all_members([], _) -> true.
+
+%% regs_is_member(Register, RegisterSet) -> true|false
+%%  Test whether Register is part of the register set.
+
+regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0;
+regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0;
+regs_is_member(_, _) -> false.
+
+%% regs_to_list(RegisterSet) -> [Register]
+%%  Convert the register set to an explicit list of registers.
+regs_to_list({Xregs,Yregs}) ->
+    regs_to_list_1(Xregs, 0, x, regs_to_list_1(Yregs, 0, y, [])).
+
+regs_to_list_1(0, _, _, Acc) ->
+    Acc;
+regs_to_list_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 ->
+    regs_to_list_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]);
+regs_to_list_1(Regs, N, Tag, Acc) ->
+    regs_to_list_1(Regs bsr 1, N+1, Tag, Acc).
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 5017fd2c23..3f250a6d5a 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -162,6 +162,10 @@ expand_opt(report, Os) ->
     [report_errors,report_warnings|Os];
 expand_opt(return, Os) ->
     [return_errors,return_warnings|Os];
+expand_opt(r12, Os) ->
+    [no_recv_opt|Os];
+expand_opt(r13, Os) ->
+    [no_recv_opt|Os];
 expand_opt({debug_info_key,_}=O, Os) ->
     [encrypt_debug_info,O|Os];
 expand_opt(no_float_opt, Os) ->
@@ -621,6 +625,8 @@ asm_passes() ->
 	 {iff,dclean,{listing,"clean"}},
 	 {unless,no_bsm_opt,{pass,beam_bsm}},
 	 {iff,dbsm,{listing,"bsm"}},
+	 {unless,no_recv_opt,{pass,beam_receive}},
+	 {iff,drecv,{listing,"recv"}},
 	 {unless,no_stack_trimming,{pass,beam_trim}},
 	 {iff,dtrim,{listing,"trim"}},
 	 {pass,beam_flatten}]},
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index b0311365c4..1bb62f41cf 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -33,6 +33,7 @@
 	     beam_listing,
 	     beam_opcodes,
 	     beam_peep,
+	     beam_receive,
 	     beam_trim,
 	     beam_type,
 	     beam_utils,
-- 
cgit v1.2.3


From f39e0b6bbc5f5d9f6a55b87847bcad7707309883 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 22 Apr 2010 13:37:18 +0200
Subject: compiler test: Test optimization of receive statements

We don't attempt to run the generated code, but use beam_disasm
and check for the presence or absence (as appropriate) of the
recv_mark/1 and recv_set/1 instructions.
---
 lib/compiler/test/receive_SUITE.erl                | 53 +++++++++++-
 .../test/receive_SUITE_data/ref_opt/no_1.erl       | 99 ++++++++++++++++++++++
 .../test/receive_SUITE_data/ref_opt/no_2.erl       | 26 ++++++
 .../test/receive_SUITE_data/ref_opt/no_3.erl       | 14 +++
 .../test/receive_SUITE_data/ref_opt/yes_1.erl      | 12 +++
 .../test/receive_SUITE_data/ref_opt/yes_2.erl      | 13 +++
 .../test/receive_SUITE_data/ref_opt/yes_3.erl      | 16 ++++
 .../test/receive_SUITE_data/ref_opt/yes_4.erl      | 16 ++++
 .../test/receive_SUITE_data/ref_opt/yes_5.erl      | 46 ++++++++++
 .../test/receive_SUITE_data/ref_opt/yes_6.erl      | 15 ++++
 .../test/receive_SUITE_data/ref_opt/yes_7.erl      | 12 +++
 .../test/receive_SUITE_data/ref_opt/yes_8.erl      | 15 ++++
 .../test/receive_SUITE_data/ref_opt/yes_9.erl      | 13 +++
 13 files changed, 347 insertions(+), 3 deletions(-)
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl
 create mode 100644 lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl

(limited to 'lib')

diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index cb8833759a..3cfc22ddc9 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -21,7 +21,7 @@
 -module(receive_SUITE).
 
 -export([all/1,init_per_testcase/2,fin_per_testcase/2,
-	 recv/1,coverage/1,otp_7980/1]).
+	 recv/1,coverage/1,otp_7980/1,ref_opt/1]).
 
 -include("test_server.hrl").
 
@@ -36,7 +36,7 @@ fin_per_testcase(_Case, Config) ->
 
 all(suite) ->
     test_lib:recompile(?MODULE),
-    [recv,coverage,otp_7980].
+    [recv,coverage,otp_7980,ref_opt].
 
 -record(state, {ena = true}).
 
@@ -157,5 +157,52 @@ otp_7980_add_clients(Count) ->
 			end,
 			N - 1
 		end, Count, [1,2,3]).
-    
+
+ref_opt(Config) when is_list(Config) ->
+    case ?MODULE of
+	receive_SUITE -> ref_opt_1(Config);
+	_ -> {skip,"Enough to run this case once."}
+    end.
+
+ref_opt_1(Config) ->
+    ?line DataDir = ?config(data_dir, Config),
+    ?line PrivDir = ?config(priv_dir, Config),
+    ?line Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.erl"])),
+    ?line test_lib:p_run(fun(Src) ->
+				 do_ref_opt(Src, PrivDir)
+			 end, Sources),
+    ok.
+
+do_ref_opt(Source, PrivDir) ->
+    try
+	{ok,Mod} = c:c(Source, [{outdir,PrivDir}]),
+	ok = Mod:Mod(),
+	Base = filename:rootname(filename:basename(Source), ".erl"),
+	BeamFile = filename:join(PrivDir, Base),
+	{beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile),
+	case Base of
+	    "no_"++_ ->
+		[] = collect_recv_opt_instrs(Code);
+	    "yes_"++_ ->
+		[{recv_mark,{f,L}},{recv_set,{f,L}}] =
+		    collect_recv_opt_instrs(Code)
+	end,
+	ok
+    catch Class:Error ->
+	    io:format("~s: ~p ~p\n~p\n",
+		      [Source,Class,Error,erlang:get_stacktrace()]),
+	    error
+    end.
+
+collect_recv_opt_instrs(Code) ->
+    L = [ [I || I <- Is,
+		begin
+		    case I of
+			{recv_mark,{f,_}} -> true;
+			{recv_set,{f,_}} -> true;
+			_ -> false
+		    end
+		end] || {function,_,_,_,Is} <- Code],
+    lists:append(L).
+
 id(I) -> I.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl
new file mode 100644
index 0000000000..bc63dac437
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl
@@ -0,0 +1,99 @@
+-module(no_1).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f1(X) ->
+    Ref = make_ref(),
+    receive
+	_ when [X] =:= Ref ->
+	    ok
+    end.
+
+f2(X, Y) ->
+    _Ref = make_ref(),
+    receive
+	_ when X =:= Y ->
+	    ok
+    end.
+
+f3(X) ->
+    Ref = make_ref(),
+    receive
+	_ when X =:= Ref ->
+	    ok
+    end.
+
+f4(X) ->
+    Ref = make_ref(),
+    receive
+	{X,_} when not X =:= Ref ->
+	    ok
+    end.
+
+f5(X) ->
+    Ref = make_ref(),
+    receive
+	{Y,_} when X =:= Y; Y =:= Ref ->
+	    ok
+    end.
+
+f6(X) ->
+    Ref = make_ref(),
+    receive
+	{Y,_} when Y =:= Ref; Ref =:= X ->
+	    ok
+    end.
+
+f7(X) ->
+    Ref = make_ref(),
+    receive
+	{Y,_} when Y =:= Ref; not (X =:= Ref) ->
+	    ok
+    end.
+
+f8(X) ->
+    Ref = make_ref(),
+    receive
+	{Y,_} when not (X =:= Ref); Y =:= Ref ->
+	    ok
+    end.
+
+f9(X) ->
+    Ref = make_ref(),
+    receive
+	{Y,_} when (not (X =:= Ref)) or (Y =:= Ref) ->
+	    ok
+    end.
+
+f10(X, Y) ->
+    Ref = make_ref(),
+    receive
+	{Z,_} when not (X =:= Y andalso Z =:= Ref) ->
+	    ok
+    end.
+
+f11(X, Y) ->
+    Ref = make_ref(),
+    receive
+	{Z,_} when not ((X =:= Y) and (Z =:= Ref)) ->
+	    ok
+    end.
+
+f12(X, Y) ->
+    Ref = make_ref(),
+    receive
+	{Z,_} when not ((Z =:= Ref) and (X =:= Y)) ->
+	    ok
+    end.
+
+f13() ->
+    Ref = make_ref(),
+    RefCopy = id(Ref),
+    receive
+	_ when hd([RefCopy]) =:= Ref ->
+	    ok
+    end.
+
+id(I) -> I.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl
new file mode 100644
index 0000000000..bc8d30c2ac
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl
@@ -0,0 +1,26 @@
+-module(no_2).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f1() ->
+    Ref = make_ref(),
+    receive
+	{'DOWN',Ref} ->
+	    ok;
+	{'DOWN',_} ->
+	    ok
+    end.
+
+f2(Pid, Msg) ->
+    Ref = erlang:monitor(process, Pid),
+    Pid ! Msg,
+    receive
+	{ok,Ref,Reply} ->
+	    {ok,Reply};
+	{error,Ref,Reply} ->
+	    {error,Reply};
+	{error,A,B} ->
+	    {error,A,B}
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl
new file mode 100644
index 0000000000..44cf8d7f71
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl
@@ -0,0 +1,14 @@
+-module(no_3).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(X) ->
+    Ref = case X of
+	      false -> ref;
+	      true -> make_ref()
+	  end,
+    receive
+	Ref -> ok
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl
new file mode 100644
index 0000000000..e2ebe234c1
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl
@@ -0,0 +1,12 @@
+-module(yes_1).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f() ->
+    Ref = make_ref(),
+    receive
+	{Ref,Reply} ->
+	    Reply
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl
new file mode 100644
index 0000000000..6077cdcab9
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl
@@ -0,0 +1,13 @@
+-module(yes_2).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(Pid, Msg) ->
+    Ref = make_ref(),
+    Pid ! Msg,
+    receive
+	{Ref,Reply} ->
+	    Reply
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl
new file mode 100644
index 0000000000..28efc542ae
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl
@@ -0,0 +1,16 @@
+-module(yes_3).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(Pid, Msg) ->
+    Ref = make_ref(),
+    do_send(Pid, Msg),
+    receive
+	{Ref,Reply} ->
+	    Reply
+    end.
+
+do_send(Pid, Msg) ->
+    Pid ! Msg.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl
new file mode 100644
index 0000000000..d1ba4832c7
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl
@@ -0,0 +1,16 @@
+-module(yes_4).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(Pid, Msg) ->
+    Ref = make_ref(),
+    catch do_send(Pid, Msg),
+    receive
+	{Ref,Reply} ->
+	    Reply
+    end.
+
+do_send(Pid, Msg) ->
+    Pid ! Msg.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl
new file mode 100644
index 0000000000..3f02fba6a6
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl
@@ -0,0 +1,46 @@
+-module(yes_5).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+do_call(Process, Label, Request, Timeout) ->
+    Node = case Process of
+	       {_S, N} when is_atom(N) ->
+		   N;
+	       _ when is_pid(Process) ->
+		   node(Process)
+	   end,
+    try erlang:monitor(process, Process) of
+	Mref ->
+	    catch erlang:send(Process, {Label, {self(), Mref}, Request},
+			      [noconnect]),
+	    receive
+		{Mref, Reply} ->
+		    erlang:demonitor(Mref, [flush]),
+		    {ok, Reply};
+		{'DOWN', Mref, _, _, noconnection} ->
+		    exit({nodedown, Node});
+		{'DOWN', Mref, _, _, Reason} ->
+		    exit(Reason)
+	    after Timeout ->
+		    erlang:demonitor(Mref),
+		    receive
+			{'DOWN', Mref, _, _, _} -> true
+		    after 0 -> true
+		    end,
+		    exit(timeout)
+	    end
+    catch
+	error:_ ->
+	    monitor_node(Node, true),
+	    receive
+		{nodedown, Node} ->
+		    monitor_node(Node, false),
+		    exit({nodedown, Node})
+	    after 0 ->
+		    Tag = make_ref(),
+		    Process ! {Label, {self(), Tag}, Request},
+		    ?MODULE:wait_resp(Node, Tag, Timeout)
+	    end
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl
new file mode 100644
index 0000000000..c54b636aa6
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl
@@ -0,0 +1,15 @@
+-module(yes_6).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(Pid, Msg) ->
+    Ref = erlang:monitor(process, Pid),
+    Pid ! Msg,
+    receive
+	{ok,Ref,Reply} ->
+	    {ok,Reply};
+	{error,Ref,Reply} ->
+	    {error,Reply}
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl
new file mode 100644
index 0000000000..849eab1746
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl
@@ -0,0 +1,12 @@
+-module(yes_7).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(X, Y) ->
+    Ref = make_ref(),
+    receive
+	{Z,_} when X =:= Y, Ref =:= Z ->
+	    ok
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl
new file mode 100644
index 0000000000..a47fe8cfbf
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl
@@ -0,0 +1,15 @@
+-module(yes_8).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+%% Cover use of floating point registers.
+
+f(Pid, X) when is_float(X) ->
+    Ref = make_ref(),
+    Pid ! {X+3},
+    receive
+	Ref ->
+	    ok
+    end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl
new file mode 100644
index 0000000000..97fce5e734
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl
@@ -0,0 +1,13 @@
+-module(yes_9).
+-compile(export_all).
+
+?MODULE() ->
+    ok.
+
+f(Fun) ->
+    Ref = make_ref(),
+    Fun(),
+    receive
+	{Ref,Reply} ->
+	    Reply
+    end.
-- 
cgit v1.2.3


From f7829c91d742f1daea27b7ff5d8dcb5f262fd3a9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Sat, 24 Apr 2010 07:57:44 +0200
Subject: compiler tests: Cover the error handling code in beam_receive

---
 lib/compiler/test/misc_SUITE.erl | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'lib')

diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index e096571d50..df8a0ffe6f 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -154,6 +154,17 @@ silly_coverage(Config) when is_list(Config) ->
 		   {test,bs_get_binary2,{f,99},0,[{x,0},{atom,all},1,[]],{x,0}},
 		   {block,[a|b]}]}],0},
     ?line expect_error(fun() -> beam_bsm:module(BsmInput, []) end),
+
+    %% beam_receive.
+    ReceiveInput = {?MODULE,[{foo,0}],[],
+		    [{function,foo,0,2,
+		      [{label,1},
+		       {func_info,{atom,?MODULE},{atom,foo},0},
+		       {label,2},
+		       {call_ext,0,{extfunc,erlang,make_ref,0}},
+		       {block,[a|b]}]}],0},
+    ?line expect_error(fun() -> beam_receive:module(ReceiveInput, []) end),
+
     ok.
 
 expect_error(Fun) ->
-- 
cgit v1.2.3


From 84f65232d00de87042b11b07db4dad30cc7e1fa4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Fri, 23 Apr 2010 12:02:12 +0200
Subject: Test that gen_server:call/2,3 are fast even with a huge message queue

---
 lib/stdlib/test/gen_server_SUITE.erl | 45 ++++++++++++++++++++++++++++++++++--
 1 file changed, 43 insertions(+), 2 deletions(-)

(limited to 'lib')

diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 6efdce78a1..f753ebc534 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -30,7 +30,8 @@
 	 call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1,
 	 spec_init_local_registered_parent/1, 
 	 spec_init_global_registered_parent/1,
-	 otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1
+	 otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1,
+	 call_with_huge_message_queue/1
 	]).
 
 % spawn export
@@ -51,7 +52,8 @@ all(suite) ->
      call_remote_n2, call_remote_n3, spec_init,
      spec_init_local_registered_parent,
      spec_init_global_registered_parent,
-     otp_5854, hibernate, otp_7669, call_format_status].
+     otp_5854, hibernate, otp_7669, call_format_status,
+     call_with_huge_message_queue].
 
 -define(default_timeout, ?t:minutes(1)).
  
@@ -904,6 +906,45 @@ call_format_status(Config) when is_list(Config) ->
     ?line [format_status_called | _] = lists:reverse(Data2),
     ok.
 
+%% Test that the time for a huge message queue is not
+%% significantly slower than with an empty message queue.
+call_with_huge_message_queue(Config) when is_list(Config) ->
+    ?line Pid = spawn_link(fun echo_loop/0),
+
+    ?line {Time,ok} = tc(fun() -> calls(10, Pid) end),
+
+    ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+    erlang:garbage_collect(),
+    ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end),
+    io:format("Time for empty message queue: ~p", [Time]),
+    io:format("Time for huge message queue: ~p", [NewTime]),
+
+    case (NewTime+1) / (Time+1) of
+	Q when Q < 10 ->
+	    ok;
+	Q ->
+	    io:format("Q = ~p", [Q]),
+	    ?line ?t:fail()
+    end,
+    ok.
+
+calls(0, _) -> ok;
+calls(N, Pid) ->
+    {ultimate_answer,42} = call(Pid, {ultimate_answer,42}),
+    calls(N-1, Pid).
+
+call(Pid, Msg) ->
+    gen_server:call(Pid, Msg, infinity).
+
+tc(Fun) ->
+    timer:tc(erlang, apply, [Fun,[]]).
+
+echo_loop() ->
+    receive
+	{'$gen_call',{Pid,Ref},Msg} ->
+	    Pid ! {Ref,Msg},
+	    echo_loop()
+    end.
 
 %%--------------------------------------------------------------
 %% Help functions to spec_init_*
-- 
cgit v1.2.3