aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src/gen.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/src/gen.erl')
-rw-r--r--lib/stdlib/src/gen.erl214
1 files changed, 132 insertions, 82 deletions
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index a05c2ce6fd..a7f743bd4c 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -26,7 +26,8 @@
%%%
%%% The standard behaviour should export init_it/6.
%%%-----------------------------------------------------------------
--export([start/5, start/6, debug_options/1,
+-export([start/5, start/6, debug_options/2, hibernate_after/1,
+ name/1, unregister_name/1, get_proc_name/1, get_parent/0,
call/3, call/4, reply/2, stop/1, stop/3]).
-export([init_it/6, init_it/7]).
@@ -48,6 +49,7 @@
| {'logfile', string()}.
-type option() :: {'timeout', timeout()}
| {'debug', [debug_flag()]}
+ | {'hibernate_after', timeout()}
| {'spawn_opt', [proc_lib:spawn_option()]}.
-type options() :: [option()].
@@ -124,7 +126,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) ->
init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options).
init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
- case name_register(Name) of
+ case register_name(Name) of
true ->
init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options);
{false, Pid} ->
@@ -146,57 +148,36 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
call(Process, Label, Request) ->
call(Process, Label, Request, ?default_timeout).
+%% Optimize a common case.
+call(Process, Label, Request, Timeout) when is_pid(Process),
+ Timeout =:= infinity orelse is_integer(Timeout) andalso Timeout >= 0 ->
+ do_call(Process, Label, Request, Timeout);
call(Process, Label, Request, Timeout)
when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
do_for_proc(Process, Fun).
-do_call(Process, Label, Request, Timeout) ->
- try erlang:monitor(process, Process) of
- Mref ->
- %% If the monitor/2 call failed to set up a connection to a
- %% remote node, we don't want the '!' operator to attempt
- %% to set up the connection again. (If the monitor/2 call
- %% failed due to an expired timeout, '!' too would probably
- %% have to wait for the timeout to expire.) Therefore,
- %% use erlang:send/3 with the 'noconnect' option so that it
- %% will fail immediately if there is no connection to the
- %% remote node.
-
- catch erlang:send(Process, {Label, {self(), Mref}, Request},
- [noconnect]),
- receive
- {Mref, Reply} ->
- erlang:demonitor(Mref, [flush]),
- {ok, Reply};
- {'DOWN', Mref, _, _, noconnection} ->
- Node = get_node(Process),
- exit({nodedown, Node});
- {'DOWN', Mref, _, _, Reason} ->
- exit(Reason)
- after Timeout ->
- erlang:demonitor(Mref, [flush]),
- exit(timeout)
- end
- catch
- error:_ ->
- %% Node (C/Java?) is not supporting the monitor.
- %% The other possible case -- this node is not distributed
- %% -- should have been handled earlier.
- %% Do the best possible with monitor_node/2.
- %% This code may hang indefinitely if the Process
- %% does not exist. It is only used for featureweak remote nodes.
- Node = get_node(Process),
- monitor_node(Node, true),
- receive
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after 0 ->
- Tag = make_ref(),
- Process ! {Label, {self(), Tag}, Request},
- wait_resp(Node, Tag, Timeout)
- end
+do_call(Process, Label, Request, Timeout) when is_atom(Process) =:= false ->
+ Mref = erlang:monitor(process, Process),
+
+ %% OTP-21:
+ %% Auto-connect is asynchronous. But we still use 'noconnect' to make sure
+ %% we send on the monitored connection, and not trigger a new auto-connect.
+ %%
+ erlang:send(Process, {Label, {self(), Mref}, Request}, [noconnect]),
+
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok, Reply};
+ {'DOWN', Mref, _, _, noconnection} ->
+ Node = get_node(Process),
+ exit({nodedown, Node});
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason)
+ after Timeout ->
+ erlang:demonitor(Mref, [flush]),
+ exit(timeout)
end.
get_node(Process) ->
@@ -211,19 +192,6 @@ get_node(Process) ->
node(Process)
end.
-wait_resp(Node, Tag, Timeout) ->
- receive
- {Tag, Reply} ->
- monitor_node(Node, false),
- {ok, Reply};
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after Timeout ->
- monitor_node(Node, false),
- exit(timeout)
- end.
-
%%
%% Send a reply to the client.
%%
@@ -297,19 +265,19 @@ where({global, Name}) -> global:whereis_name(Name);
where({via, Module, Name}) -> Module:whereis_name(Name);
where({local, Name}) -> whereis(Name).
-name_register({local, Name} = LN) ->
+register_name({local, Name} = LN) ->
try register(Name, self()) of
true -> true
catch
error:_ ->
{false, where(LN)}
end;
-name_register({global, Name} = GN) ->
+register_name({global, Name} = GN) ->
case global:register_name(Name, self()) of
yes -> true;
no -> {false, where(GN)}
end;
-name_register({via, Module, Name} = GN) ->
+register_name({via, Module, Name} = GN) ->
case Module:register_name(Name, self()) of
yes ->
true;
@@ -317,34 +285,116 @@ name_register({via, Module, Name} = GN) ->
{false, where(GN)}
end.
+name({local,Name}) -> Name;
+name({global,Name}) -> Name;
+name({via,_, Name}) -> Name;
+name(Pid) when is_pid(Pid) -> Pid.
+
+unregister_name({local,Name}) ->
+ try unregister(Name) of
+ _ -> ok
+ catch
+ _:_ -> ok
+ end;
+unregister_name({global,Name}) ->
+ _ = global:unregister_name(Name),
+ ok;
+unregister_name({via, Mod, Name}) ->
+ _ = Mod:unregister_name(Name),
+ ok;
+unregister_name(Pid) when is_pid(Pid) ->
+ ok.
+
+get_proc_name(Pid) when is_pid(Pid) ->
+ Pid;
+get_proc_name({local, Name}) ->
+ case process_info(self(), registered_name) of
+ {registered_name, Name} ->
+ Name;
+ {registered_name, _Name} ->
+ exit(process_not_registered);
+ [] ->
+ exit(process_not_registered)
+ end;
+get_proc_name({global, Name}) ->
+ case global:whereis_name(Name) of
+ undefined ->
+ exit(process_not_registered_globally);
+ Pid when Pid =:= self() ->
+ Name;
+ _Pid ->
+ exit(process_not_registered_globally)
+ end;
+get_proc_name({via, Mod, Name}) ->
+ case Mod:whereis_name(Name) of
+ undefined ->
+ exit({process_not_registered_via, Mod});
+ Pid when Pid =:= self() ->
+ Name;
+ _Pid ->
+ exit({process_not_registered_via, Mod})
+ end.
+
+get_parent() ->
+ case get('$ancestors') of
+ [Parent | _] when is_pid(Parent) ->
+ Parent;
+ [Parent | _] when is_atom(Parent) ->
+ name_to_pid(Parent);
+ _ ->
+ exit(process_was_not_started_by_proc_lib)
+ end.
+
+name_to_pid(Name) ->
+ case whereis(Name) of
+ undefined ->
+ case global:whereis_name(Name) of
+ undefined ->
+ exit(could_not_find_registered_name);
+ Pid ->
+ Pid
+ end;
+ Pid ->
+ Pid
+ end.
+
timeout(Options) ->
- case opt(timeout, Options) of
- {ok, Time} ->
+ case lists:keyfind(timeout, 1, Options) of
+ {_,Time} ->
Time;
- _ ->
+ false ->
infinity
end.
spawn_opts(Options) ->
- case opt(spawn_opt, Options) of
- {ok, Opts} ->
+ case lists:keyfind(spawn_opt, 1, Options) of
+ {_,Opts} ->
Opts;
- _ ->
+ false ->
[]
end.
-opt(Op, [{Op, Value}|_]) ->
- {ok, Value};
-opt(Op, [_|Options]) ->
- opt(Op, Options);
-opt(_, []) ->
- false.
-
-debug_options(Opts) ->
- case opt(debug, Opts) of
- {ok, Options} -> sys:debug_options(Options);
- _ -> []
+hibernate_after(Options) ->
+ case lists:keyfind(hibernate_after, 1, Options) of
+ {_,HibernateAfterTimeout} ->
+ HibernateAfterTimeout;
+ false ->
+ infinity
+ end.
+
+debug_options(Name, Opts) ->
+ case lists:keyfind(debug, 1, Opts) of
+ {_,Options} ->
+ try sys:debug_options(Options)
+ catch _:_ ->
+ error_logger:format(
+ "~tp: ignoring erroneous debug options - ~tp~n",
+ [Name,Options]),
+ []
+ end;
+ false ->
+ []
end.
format_status_header(TagLine, Pid) when is_pid(Pid) ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-16 23:09:02 +0000