Fix receive support in erl_eval with a BEAM module

Using the low-level BEAM instructions, we can loop over each message in
the process queue and removes the first message that matches, without
receiving them all to later send them back to itself.

The function prim_eval:'receive'/2 is equivalent to the
following pseudo-code:

  'receive'(F, T) ->
    RESET MESSAGE QUEUE POINTER,
    LOOP:
      case PEEK CURRENT MESSAGE WITH TIMEOUT T of
        {ok,Msg} ->
          case F(Msg) of
            nomatch ->
              DECREMENT TIMEOUT T,
              ADVANCE MESSAGE QUEUE POINTER,
              GOTO LOOP;
            Result ->
              RESET MESSAGE QUEUE POINTER,
              Result
          end;
        timeout ->
          RESET MESSAGE QUEUE POINTER,
          timeout
      end.

To not break Dialyzer and other tools, we use a stub Erlang module which
abstract code is forcefully inserted into prim_inet.erl afterwards
compilation.

11 files changed, 175 insertions, 64 deletions

diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index fb4cde0e76..58e83540e1 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -559,13 +559,14 @@ GENERATE += $(TTF_DIR)/driver_tab.c
 # Preloaded code.
 # 
 # This list must be consistent with PRE_LOADED_MODULES in
-# lib/kernel/src/Makefile.
+# erts/preloaded/src/Makefile.
 ifeq ($(TARGET),win32)
 # On windows the preloaded objects are in a resource object.
 PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
 PRELOAD_SRC = $(TARGET)/beams.rc
 $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+			$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
@@ -579,6 +580,7 @@ PRELOAD_OBJ = $(OBJDIR)/preload.o
 PRELOAD_SRC = $(TARGET)/preload.c
 $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+			$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
 			$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
new file mode 100644
index 0000000000..c5caa21943
--- /dev/null
+++ b/erts/preloaded/ebin/prim_eval.beam
diff --git a/erts/preloaded/src/.gitignore b/erts/preloaded/src/.gitignore
new file mode 100644
index 0000000000..e4658fe142
--- /dev/null
+++ b/erts/preloaded/src/.gitignore
@@ -0,0 +1 @@
+prim_eval.abstr
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index a224b6a5d4..f53809e765 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -32,7 +32,7 @@ STATIC_EBIN=../ebin
 include $(ERL_TOP)/erts/vsn.mk
 include $(ERL_TOP)/lib/kernel/vsn.mk
 
-PRE_LOADED_MODULES = \
+PRE_LOADED_ERL_MODULES = \
 	erl_prim_loader \
 	init \
 	prim_file \
@@ -43,10 +43,17 @@ PRE_LOADED_MODULES = \
 	erlang \
 	erts_internal
 
+PRE_LOADED_BEAM_MODULES = \
+	prim_eval
+
+PRE_LOADED_MODULES = $(PRE_LOADED_ERL_MODULES) $(PRE_LOADED_BEAM_MODULES)
+
 RELSYSDIR = $(RELEASE_PATH)/lib/erts-$(VSN)
 # not $(RELEASE_PATH)/erts-$(VSN)/preloaded
 
-ERL_FILES= $(PRE_LOADED_MODULES:%=%.erl) 
+ERL_FILES= $(PRE_LOADED_ERL_MODULES:%=%.erl)
+BEAM_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.S)
+STUBS_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.erl)
 
 TARGET_FILES = $(PRE_LOADED_MODULES:%=$(EBIN)/%.$(EMULATOR))
 STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR))
@@ -70,7 +77,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk
 
 release_spec: 
 	$(INSTALL_DIR) "$(RELSYSDIR)/src"
-	$(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
+	$(INSTALL_DATA) $(ERL_FILES) $(BEAM_FILES) $(STUBS_FILES) "$(RELSYSDIR)/src"
 	$(INSTALL_DIR) "$(RELSYSDIR)/ebin"
 	$(INSTALL_DATA) $(STATIC_TARGET_FILES) "$(RELSYSDIR)/ebin"
 
@@ -80,6 +87,19 @@ release_docs_spec:
 list_preloaded:
 	@echo $(PRE_LOADED_MODULES)
 
+#
+# Combine a BEAM assembly script file a stub Erlang file into a BEAM file.
+# See add_abstract_chunk script.
+#
+
+prim_eval.abstr: prim_eval.erl
+	$(V_ERLC) $(ERL_COMPILE_FLAGS) -o$(dir $@) +dabstr $<
+
+prim_eval.beam: prim_eval.S prim_eval.abstr
+	$(gen_verbose)
+	$(V_at)$(ERLC) $(ERL_COMPILE_FLAGS) $<
+	$(V_at)escript add_abstract_code $@ prim_eval.abstr || (rm $@; exit 1)
+
 # Include dependencies -- list below added by PaN
 $(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl
 $(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl
diff --git a/erts/preloaded/src/add_abstract_code b/erts/preloaded/src/add_abstract_code
new file mode 100644
index 0000000000..e670156d21
--- /dev/null
+++ b/erts/preloaded/src/add_abstract_code
@@ -0,0 +1,34 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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%
+%%
+
+-mode(compile).
+
+-export([main/1]).
+
+main([BeamFile,AbstrFile]) ->
+    {ok,_,Chunks0} = beam_lib:all_chunks(BeamFile),
+    {ok,Abstr} = file:consult(AbstrFile),
+    Chunks = lists:keyreplace("Abst", 1, Chunks0,
+			      {"Abst",term_to_binary({raw_abstract_v1,Abstr})}),
+    {ok,Module} = beam_lib:build_module(Chunks),
+    ok = file:write_file(BeamFile, Module),
+    init:stop().
diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S
new file mode 100644
index 0000000000..958a79a1da
--- /dev/null
+++ b/erts/preloaded/src/prim_eval.S
@@ -0,0 +1,70 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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, prim_eval}.
+
+%% This module uses low-level BEAM instructions for the message queue facility
+%% to allow erl_eval to evaluate receive expressions correctly.
+
+{exports, [{'receive',2},{module_info,0},{module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 10}.
+
+
+{function, 'receive', 2, 2}.
+  {label,1}.
+    {func_info,{atom,prim_eval},{atom,'receive'},2}.
+  {label,2}.
+    {allocate,2,2}.
+    {move,{x,1},{y,0}}.
+    {move,{x,0},{y,1}}.
+  {label,3}.
+    {loop_rec,{f,5},{x,0}}.
+    {move,{y,1},{x,1}}.
+    {call_fun,1}.
+    {test,is_ne_exact,{f,4},[{x,0},{atom,nomatch}]}.
+    remove_message.
+    {deallocate,2}.
+    return.
+  {label,4}.
+    {loop_rec_end,{f,3}}.
+  {label,5}.
+    {wait_timeout,{f,3},{y,0}}.
+    timeout.
+    {move,{atom,timeout},{x,0}}.
+    {deallocate,2}.
+    return.
+
+
+{function, module_info, 0, 8}.
+  {label,6}.
+    {func_info,{atom,prim_eval},{atom,module_info},0}.
+  {label,7}.
+    {move,{atom,prim_eval},{x,0}}.
+    {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 10}.
+  {label,8}.
+    {func_info,{atom,prim_eval},{atom,module_info},1}.
+  {label,9}.
+    {move,{x,0},{x,1}}.
+    {move,{atom,prim_eval},{x,0}}.
+    {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/erts/preloaded/src/prim_eval.erl b/erts/preloaded/src/prim_eval.erl
new file mode 100644
index 0000000000..ec5af8c138
--- /dev/null
+++ b/erts/preloaded/src/prim_eval.erl
@@ -0,0 +1,28 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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(prim_eval).
+
+%% This module is simply a stub which abstract code gets included in the result
+%% of compilation of prim_eval.S, to keep Dialyzer happy.
+
+-export(['receive'/2]).
+
+-spec 'receive'(fun((term()) -> nomatch | T), timeout()) -> T.
+'receive'(_, _) ->
+    erlang:nif_error(stub).
diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml
index 19a3f37819..de243343ff 100644
--- a/lib/reltool/doc/src/reltool_examples.xml
+++ b/lib/reltool/doc/src/reltool_examples.xml
@@ -261,7 +261,8 @@ Eshell V5.7.3  (abort with ^G)
 8&gt;  reltool:get_script(Server, "NAME").
 {ok,{script,{"NAME","VSN"},
             [{preLoaded,[erl_prim_loader,erlang,init,otp_ring0,
-                         prim_file,prim_inet,prim_zip,zlib]},
+                         prim_eval,prim_file,prim_inet,prim_zip,
+                         zlib]},
              {progress,preloaded},
              {path,["$ROOT/lib/kernel-2.13/ebin",
                     "$ROOT/lib/stdlib-1.16/ebin"]},
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 193dbb64bf..b2e95fdbee 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1461,8 +1461,8 @@ mandatory_modules() ->
 
 preloaded() ->
     %% Sorted
-    [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_file,prim_inet,
-     prim_zip,zlib]. 
+    [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file,
+     prim_inet,prim_zip,zlib].
 
 %%______________________________________________________________________
 %% Kernel processes; processes that are specially treated by the init
diff --git a/lib/stdlib/doc/src/erl_eval.xml b/lib/stdlib/doc/src/erl_eval.xml
index d0622594d9..24940f8396 100644
--- a/lib/stdlib/doc/src/erl_eval.xml
+++ b/lib/stdlib/doc/src/erl_eval.xml
@@ -288,10 +288,7 @@ Func(FuncSpec, Arguments)        </code>
 
   <section>
     <title>Bugs</title>
-    <p>The evaluator is not complete. <c>receive</c> cannot be
-      handled properly.
-      </p>
-    <p>Any undocumented functions in <c>erl_eval</c> should not be used.</p>
+    <p>Undocumented functions in <c>erl_eval</c> should not be used.</p>
   </section>
 </erlref>
 
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 0b57af1b6d..73b8da335a 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -245,10 +245,10 @@ expr({'case',_,E,Cs}, Bs0, Lf, Ef, RBs) ->
 expr({'try',_,B,Cases,Catches,AB}, Bs, Lf, Ef, RBs) ->
     try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs);
 expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) ->
-    receive_clauses(Cs, Bs, Lf, Ef, [], RBs);
+    receive_clauses(Cs, Bs, Lf, Ef, RBs);
 expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) ->
     {value,T,Bs} = expr(E, Bs0, Lf, Ef, none),
-    receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs);
+    receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, RBs);
 expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) ->
     {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef),
     F = erlang:make_fun(Mod, Name, Arity),
@@ -807,66 +807,24 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) ->
     end.
 
 %%
-%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, Messages, RBs) 
+%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, RBs)
 %%
-receive_clauses(Cs, Bs, Lf, Ef, Ms, RBs) ->
-    receive
-	Val ->
-	    case match_clause(Cs, [Val], Bs, Lf, Ef) of
-		{B, Bs1} ->
-		    merge_queue(Ms),
-		    exprs(B, Bs1, Lf, Ef, RBs);
-		nomatch ->
-		    receive_clauses(Cs, Bs, Lf, Ef, [Val|Ms], RBs)
-	    end
-    end.
+receive_clauses(Cs, Bs, Lf, Ef, RBs) ->
+    receive_clauses(infinity, Cs, unused, Bs, Lf, Ef, RBs).
 %%
 %% receive_clauses(TimeOut, Clauses, TimeoutBody, Bindings, 
 %%                 ExternalFuncHandler, LocalFuncHandler, RBs)
 %%
-receive_clauses(T, Cs, TB, Bs, Lf, Ef, Ms, RBs) ->
-    {_,_} = statistics(runtime),
-    receive
-	Val ->
-	    case match_clause(Cs, [Val], Bs, Lf, Ef) of
-		{B, Bs1} ->
-		    merge_queue(Ms),
-		    exprs(B, Bs1, Lf, Ef, RBs);
-		nomatch ->
-		    {_,T1} = statistics(runtime),
-		    if
-			T =:= infinity ->
-			    receive_clauses(T, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs);
-			T-T1 =< 0 ->
-			    receive_clauses(0, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs);
-			true ->
-			    receive_clauses(T-T1, Cs,TB,Bs,Lf,Ef,[Val|Ms],RBs)
-		    end
-	    end
-    after T ->
-	    merge_queue(Ms),
+receive_clauses(T, Cs, TB, Bs, Lf, Ef, RBs) ->
+    F = fun (M) -> match_clause(Cs, [M], Bs, Lf, Ef) end,
+    case prim_eval:'receive'(F, T) of
+	{B, Bs1} ->
+	    exprs(B, Bs1, Lf, Ef, RBs);
+	timeout ->
 	    {B, Bs1} = TB,
 	    exprs(B, Bs1, Lf, Ef, RBs)
     end.
 
-merge_queue([]) -> 
-    true;
-merge_queue(Ms) ->
-    send_all(recv_all(Ms), self()).
-
-recv_all(Xs) ->
-    receive
-	X -> recv_all([X|Xs])
-    after 0 ->
-	    reverse(Xs)
-    end.
-
-send_all([X|Xs], Self) ->
-    Self ! X,
-    send_all(Xs, Self);
-send_all([], _) -> true.
-
-
 %% match_clause -> {Body, Bindings} or nomatch
 
 -spec(match_clause(Clauses, ValueList, Bindings, LocalFunctionHandler) ->