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.erl320
1 files changed, 320 insertions, 0 deletions
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
new file mode 100644
index 0000000000..5aab547644
--- /dev/null
+++ b/lib/stdlib/src/gen.erl
@@ -0,0 +1,320 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. 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(gen).
+
+%%%-----------------------------------------------------------------
+%%% This module implements the really generic stuff of the generic
+%%% standard behaviours (e.g. gen_server, gen_fsm).
+%%%
+%%% The standard behaviour should export init_it/6.
+%%%-----------------------------------------------------------------
+-export([start/5, start/6, debug_options/1,
+ call/3, call/4, reply/2]).
+
+-export([init_it/6, init_it/7]).
+
+-define(default_timeout, 5000).
+
+%%-----------------------------------------------------------------
+
+-type linkage() :: 'link' | 'nolink'.
+-type emgr_name() :: {'local', atom()} | {'global', term()}.
+
+-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}.
+
+-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
+ | {'logfile', string()}.
+-type option() :: {'timeout', timeout()}
+ | {'debug', [debug_flag()]}
+ | {'spawn_opt', [proc_lib:spawn_option()]}.
+-type options() :: [option()].
+
+%%-----------------------------------------------------------------
+%% Starts a generic process.
+%% start(GenMod, LinkP, Mod, Args, Options)
+%% start(GenMod, LinkP, Name, Mod, Args, Options)
+%% GenMod = atom(), callback module implementing the 'real' fsm
+%% LinkP = link | nolink
+%% Name = {local, atom()} | {global, term()}
+%% Args = term(), init arguments (to Mod:init/1)
+%% Options = [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt, OptionList}]
+%% Flag = trace | log | {logfile, File} | statistics | debug
+%% (debug == log && statistics)
+%% Returns: {ok, Pid} | ignore |{error, Reason} |
+%% {error, {already_started, Pid}} |
+%% The 'already_started' is returned only if Name is given
+%%-----------------------------------------------------------------
+
+-spec start(module(), linkage(), emgr_name(), module(), term(), options()) ->
+ start_ret().
+
+start(GenMod, LinkP, Name, Mod, Args, Options) ->
+ case where(Name) of
+ undefined ->
+ do_spawn(GenMod, LinkP, Name, Mod, Args, Options);
+ Pid ->
+ {error, {already_started, Pid}}
+ end.
+
+-spec start(module(), linkage(), module(), term(), options()) -> start_ret().
+
+start(GenMod, LinkP, Mod, Args, Options) ->
+ do_spawn(GenMod, LinkP, Mod, Args, Options).
+
+%%-----------------------------------------------------------------
+%% Spawn the process (and link) maybe at another node.
+%% If spawn without link, set parent to ourselves 'self'!!!
+%%-----------------------------------------------------------------
+do_spawn(GenMod, link, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start_link(?MODULE, init_it,
+ [GenMod, self(), self(), Mod, Args, Options],
+ Time,
+ spawn_opts(Options));
+do_spawn(GenMod, _, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start(?MODULE, init_it,
+ [GenMod, self(), self, Mod, Args, Options],
+ Time,
+ spawn_opts(Options)).
+
+do_spawn(GenMod, link, Name, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start_link(?MODULE, init_it,
+ [GenMod, self(), self(), Name, Mod, Args, Options],
+ Time,
+ spawn_opts(Options));
+do_spawn(GenMod, _, Name, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start(?MODULE, init_it,
+ [GenMod, self(), self, Name, Mod, Args, Options],
+ Time,
+ spawn_opts(Options)).
+
+%%-----------------------------------------------------------------
+%% Initiate the new process.
+%% Register the name using the Rfunc function
+%% Calls the Mod:init/Args function.
+%% Finally an acknowledge is sent to Parent and the main
+%% loop is entered.
+%%-----------------------------------------------------------------
+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
+ true ->
+ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options);
+ {false, Pid} ->
+ proc_lib:init_ack(Starter, {error, {already_started, Pid}})
+ end.
+
+init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
+ GenMod:init_it(Starter, Parent, Name, Mod, Args, Options).
+
+%%-----------------------------------------------------------------
+%% Makes a synchronous call to a generic process.
+%% Request is sent to the Pid, and the response must be
+%% {Tag, _, Reply}.
+%%-----------------------------------------------------------------
+
+%%% New call function which uses the new monitor BIF
+%%% call(ServerId, Label, Request)
+
+call(Process, Label, Request) ->
+ call(Process, Label, Request, ?default_timeout).
+
+%% Local or remote by pid
+call(Pid, Label, Request, Timeout)
+ when is_pid(Pid), Timeout =:= infinity;
+ is_pid(Pid), is_integer(Timeout), Timeout >= 0 ->
+ do_call(Pid, Label, Request, Timeout);
+%% Local by name
+call(Name, Label, Request, Timeout)
+ when is_atom(Name), Timeout =:= infinity;
+ is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ do_call(Pid, Label, Request, Timeout);
+ undefined ->
+ exit(noproc)
+ end;
+%% Global by name
+call({global, _Name}=Process, Label, Request, Timeout)
+ when Timeout =:= infinity;
+ is_integer(Timeout), Timeout >= 0 ->
+ case where(Process) of
+ Pid when is_pid(Pid) ->
+ Node = node(Pid),
+ try do_call(Pid, Label, Request, Timeout)
+ catch
+ exit:{nodedown, Node} ->
+ %% A nodedown not yet detected by global,
+ %% pretend that it was.
+ exit(noproc)
+ end;
+ undefined ->
+ exit(noproc)
+ end;
+%% Local by name in disguise
+call({Name, Node}, Label, Request, Timeout)
+ when Node =:= node(), Timeout =:= infinity;
+ Node =:= node(), is_integer(Timeout), Timeout >= 0 ->
+ call(Name, Label, Request, Timeout);
+%% Remote by name
+call({_Name, Node}=Process, Label, Request, Timeout)
+ when is_atom(Node), Timeout =:= infinity;
+ is_atom(Node), is_integer(Timeout), Timeout >= 0 ->
+ if
+ node() =:= nonode@nohost ->
+ exit({nodedown, Node});
+ true ->
+ do_call(Process, Label, Request, Timeout)
+ end.
+
+do_call(Process, Label, Request, Timeout) ->
+ %% We trust the arguments to be correct, i.e
+ %% Process is either a local or remote pid,
+ %% or a {Name, Node} tuple (of atoms) and in this
+ %% case this node (node()) _is_ distributed and Node =/= node().
+ 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 ->
+ %% 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]),
+ wait_resp_mon(Node, Mref, Timeout)
+ 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.
+ 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
+ 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} ->
+ 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.
+%%
+reply({To, Tag}, Reply) ->
+ Msg = {Tag, Reply},
+ try To ! Msg catch _:_ -> Msg end.
+
+%%%-----------------------------------------------------------------
+%%% Misc. functions.
+%%%-----------------------------------------------------------------
+where({global, Name}) -> global:safe_whereis_name(Name);
+where({local, Name}) -> whereis(Name).
+
+name_register({local, Name} = LN) ->
+ try register(Name, self()) of
+ true -> true
+ catch
+ error:_ ->
+ {false, where(LN)}
+ end;
+name_register({global, Name} = GN) ->
+ case global:register_name(Name, self()) of
+ yes -> true;
+ no -> {false, where(GN)}
+ end.
+
+timeout(Options) ->
+ case opt(timeout, Options) of
+ {ok, Time} ->
+ Time;
+ _ ->
+ infinity
+ end.
+
+spawn_opts(Options) ->
+ case opt(spawn_opt, Options) of
+ {ok, Opts} ->
+ Opts;
+ _ ->
+ []
+ 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);
+ _ -> []
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 10:04:22 +0000