From acb8ef5d18cc3976bf580a8e6925cb5641acd401 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Mon, 6 May 2013 20:09:39 +0200 Subject: 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. --- lib/reltool/doc/src/reltool_examples.xml | 3 +- lib/sasl/src/systools_make.erl | 4 +- lib/stdlib/doc/src/erl_eval.xml | 5 +-- lib/stdlib/src/erl_eval.erl | 64 ++++++-------------------------- 4 files changed, 16 insertions(+), 60 deletions(-) (limited to 'lib') 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> 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)
Bugs -

The evaluator is not complete. receive cannot be - handled properly. -

-

Any undocumented functions in erl_eval should not be used.

+

Undocumented functions in erl_eval should not be used.

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) -> -- cgit v1.2.3