Optimise io requests for long message queues

Ensure that the monitor reference is present in all receive clauses, so
that the compiler optimisation kicks in and the run time won't depend on
the length of the message queue of the calling process.

Remove the 'EXIT' clause, as its presence breaks the optimisation, and
that case is handled by the 'DOWN' clause anyway.

The test io_SUITE:io_with_huge_message_queue is an adaptation of
gen_server_SUITE:call_with_huge_message_queue.

3 files changed, 65 insertions, 31 deletions

diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml
index 9328704e11..d6da205f07 100644
--- a/lib/stdlib/doc/src/io_protocol.xml
+++ b/lib/stdlib/doc/src/io_protocol.xml
@@ -76,10 +76,11 @@ the server eventually sends a corresponding <c>io_reply</c> tuple.</p>
 the I/O server sends the IO reply to.</item>
 
 <item><c>ReplyAs</c> can be any datum and is returned in the corresponding
-<c>io_reply</c>. The <seealso marker="stdlib:io">io</seealso> module simply uses the pid()
-of the I/O server as the <c>ReplyAs</c> datum, but a more complicated client
+<c>io_reply</c>. The <seealso marker="stdlib:io">io</seealso> module monitors
+the I/O server, and uses the monitor reference as the <c>ReplyAs</c> datum.
+A more complicated client
 could have several outstanding I/O requests to the same I/O server and
-would then use i.e. a <c>reference()</c> or something else to differentiate among
+would then use different references (or something else) to differentiate among
 the incoming IO replies. The <c>ReplyAs</c> element should be considered
 opaque by the I/O server. Note that the <c>pid()</c> of the I/O server is not
 explicitly present in the <c>io_reply</c> tuple. The reply can be sent from any
diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index 27e2a82b41..b9ace2f442 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.erl
@@ -566,12 +566,23 @@ request(Name, Request) when is_atom(Name) ->
 
 execute_request(Pid, {Convert,Converted}) ->
     Mref = erlang:monitor(process, Pid),
-    Pid ! {io_request,self(),Pid,Converted},
-    if
-	Convert ->
-	    convert_binaries(wait_io_mon_reply(Pid, Mref));
-	true ->
-	    wait_io_mon_reply(Pid, Mref)
+    Pid ! {io_request,self(),Mref,Converted},
+
+    receive
+	{io_reply, Mref, Reply} ->
+	    erlang:demonitor(Mref, [flush]),
+	    if
+		Convert ->
+		    convert_binaries(Reply);
+		true ->
+		    Reply
+	    end;
+	{'DOWN', Mref, _, _, _} ->
+	    receive
+		{'EXIT', Pid, _What} -> true
+	    after 0 -> true
+	    end,
+	    {error,terminated}
     end.
 
 requests(Requests) ->				%Requests as atomic action
@@ -597,26 +608,6 @@ default_input() ->
 default_output() ->
     group_leader().
 
-wait_io_mon_reply(From, Mref) ->
-    receive
-	{io_reply, From, Reply} ->
-	    erlang:demonitor(Mref, [flush]),
-	    Reply;
-	{'EXIT', From, _What} ->
-	    receive
-		{'DOWN', Mref, _, _, _} -> true
-	    after 0 -> true
-	    end,
-	    {error,terminated};
-	{'DOWN', Mref, _, _, _} ->
-	    receive
-		{'EXIT', From, _What} -> true
-	    after 0 -> true
-	    end,
-	    {error,terminated}
-    end.
-
-
 %% io_requests(Requests)
 %%  Transform requests into correct i/o server messages. Only handle the
 %%  one we KNOW must be changed, others, including incorrect ones, are
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 3a76275f31..2203dd8f51 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -30,7 +30,8 @@
 	 io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1,
 	 printable_range/1,
 	 io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
-         otp_10836/1, io_lib_width_too_small/1]).
+         otp_10836/1, io_lib_width_too_small/1,
+         io_with_huge_message_queue/1]).
 
 -export([pretty/2]).
 
@@ -70,7 +71,7 @@ all() ->
      io_fread_newlines, otp_8989, io_lib_fread_literal,
      printable_range,
      io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
-     io_lib_width_too_small].
+     io_lib_width_too_small, io_with_huge_message_queue].
 
 groups() -> 
     [].
@@ -2219,3 +2220,44 @@ io_lib_width_too_small(Config) ->
     "**" = lists:flatten(io_lib:format("~2.3w", [3.14])),
     "**" = lists:flatten(io_lib:format("~2.5w", [3.14])),
     ok.
+
+%% Test that the time for a huge message queue is not
+%% significantly slower than with an empty message queue.
+io_with_huge_message_queue(Config) when is_list(Config) ->
+    case test_server:is_native(gen) of
+	true ->
+	    {skip,
+	     "gen is native - huge message queue optimization "
+	     "is not implemented"};
+	false ->
+	    do_io_with_huge_message_queue(Config)
+    end.
+
+do_io_with_huge_message_queue(Config) ->
+    PrivDir = ?privdir(Config),
+    File = filename:join(PrivDir, "slask"),
+    {ok, F1} = file:open(File, [write]),
+
+    {Time,ok} = timer:tc(fun() -> writes(1000, F1) end),
+
+    [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+    erlang:garbage_collect(),
+    {NewTime,ok} = timer:tc(fun() -> writes(1000, F1) end),
+    file:close(F1),
+    io:format("Time for empty message queue: ~p", [Time]),
+    io:format("Time for huge message queue: ~p", [NewTime]),
+
+    IsCover = test_server:is_cover(),
+    case (NewTime+1) / (Time+1) of
+	Q when Q < 10; IsCover ->
+	    ok;
+	Q ->
+	    io:format("Q = ~p", [Q]),
+	    ?t:fail()
+    end,
+    ok.
+
+writes(0, _) -> ok;
+writes(N, F1) ->
+    file:write(F1, "hello\n"),
+    writes(N - 1, F1).