+
+
diff --git a/patches/gen_leader/gen_leader.erl b/patches/gen_leader/gen_leader.erl
new file mode 100644
index 0000000..ce7907b
--- /dev/null
+++ b/patches/gen_leader/gen_leader.erl
@@ -0,0 +1,1076 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% @author Ulf Wiger
+%% @author Thomas Arts
+%%
+%% @doc Leader election behaviour.
+%%
This application implements a leader election behaviour modeled after
+%% gen_server. This behaviour intends to make it reasonably
+%% straightforward to implement a fully distributed server with
+%% master-slave semantics.
+%%
The gen_leader behaviour supports nearly everything that gen_server
+%% does (some functions, such as multicall() and the internal timeout,
+%% have been removed), and adds a few callbacks and API functions to
+%% support leader election etc.
+%%
Also included is an example program, a global dictionary, based
+%% on the modules gen_leader and dict. The callback implementing the
+%% global dictionary is called 'test_cb', for no particularly logical
+%% reason.
The names of nodes capable of assuming
+%% a leadership role
+%%
Workers
+%%
The names of nodes that will be part of the "cluster",
+%% but cannot ever assume a leadership role.
+%%
Mod
The name of the callback module
+%%
Arg
Argument passed on to Mod:init/1
+%%
Options
Same as gen_server's Options
+%%
+%%
+%%
The list of candidates needs to be known from the start. Workers
+%% can be added at runtime.
+%% @end
+start_link(Name, [_|_] = CandidateNodes, Workers,
+ Mod, Arg, Options) when is_atom(Name) ->
+ gen:start(?MODULE, link, {local,Name}, Mod,
+ {CandidateNodes, Workers, Arg}, Options).
+
+start_link(Name, Mod, Arg, Options) when is_atom(Name) ->
+ gen:start(?MODULE, link, {local,Name}, Mod,
+ {local_only, Arg}, Options).
+
+%% Query functions to be used from the callback module
+
+%% @spec alive(E::election()) -> [node()]
+%%
+%% @doc Returns a list of live nodes (candidates and workers).
+%%
+alive(#election{alive = Alive}) ->
+ Alive.
+
+%% @spec down(E::election()) -> [node()]
+%%
+%% @doc Returns a list of candidates currently not running.
+%%
+down(#election{down = Down}) ->
+ Down.
+
+%% @spec candidates(E::election()) -> [node()]
+%%
+%% @doc Returns a list of known candidates.
+%%
+candidates(#election{candidate_nodes = Cands}) ->
+ Cands.
+
+%% @spec workers(E::election()) -> [node()]
+%%
+%% @doc Returns a list of known workers.
+%%
+workers(#election{worker_nodes = Workers}) ->
+ Workers.
+
+%% @spec call(Name::serverRef(), Request) -> term()
+%%
+%% @doc Equivalent to gen_server:call/2, but with a slightly
+%% different exit reason if something goes wrong. This function calls
+%% the gen_leader process exactly as if it were a gen_server
+%% (which, for practical purposes, it is.)
+%% @end
+call(Name, Request) ->
+ case catch gen:call(Name, '$gen_call', Request) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, local_call, [Name, Request]}})
+ end.
+
+%% @spec call(Name::serverRef(), Request, Timeout::integer()) ->
+%% Reply
+%%
+%% Reply = term()
+%%
+%% @doc Equivalent to gen_server:call/3, but with a slightly
+%% different exit reason if something goes wrong. This function calls
+%% the gen_leader process exactly as if it were a gen_server
+%% (which, for practical purposes, it is.)
+%% @end
+call(Name, Request, Timeout) ->
+ case catch gen:call(Name, '$gen_call', Request, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, local_call, [Name, Request, Timeout]}})
+ end.
+
+%% @spec leader_call(Name::name(), Request::term())
+%% -> Reply
+%%
+%% Reply = term()
+%%
+%% @doc Makes a call (similar to gen_server:call/2) to the
+%% leader. The call is forwarded via the local gen_leader instance, if
+%% that one isn't actually the leader. The client will exit if the
+%% leader dies while the request is outstanding.
+%%
This function uses gen:call/3, and is subject to the
+%% same default timeout as e.g. gen_server:call/2.
+%% @end
+%%
+leader_call(Name, Request) ->
+ case catch gen:call(Name, '$leader_call', Request) of
+ {ok,{leader,reply,Res}} ->
+ Res;
+ {ok,{error, leader_died}} ->
+ exit({leader_died, {?MODULE, leader_call, [Name, Request]}});
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, leader_call, [Name, Request]}})
+ end.
+
+%% @spec leader_call(Name::name(), Request::term(), Timeout::integer())
+%% -> Reply
+%%
+%% Reply = term()
+%%
+%% @doc Makes a call (similar to gen_server:call/3) to the
+%% leader. The call is forwarded via the local gen_leader instance, if
+%% that one isn't actually the leader. The client will exit if the
+%% leader dies while the request is outstanding.
+%% @end
+%%
+leader_call(Name, Request, Timeout) ->
+ case catch gen:call(Name, '$leader_call', Request, Timeout) of
+ {ok,{leader,reply,Res}} ->
+ Res;
+ {ok,{error, leader_died}} ->
+ exit({leader_died, {?MODULE, leader_call, [Name, Request]}});
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, leader_call, [Name, Request, Timeout]}})
+ end.
+
+
+
+%% @equiv gen_server:cast/2
+cast(Name, Request) ->
+ catch do_cast('$gen_cast', Name, Request),
+ ok.
+
+%% @spec leader_cast(Name::name(), Msg::term()) -> ok
+%% @doc Similar to gen_server:cast/2 but will be forwarded to
+%% the leader via the local gen_leader instance.
+leader_cast(Name, Request) ->
+ catch do_cast('$leader_cast', Name, Request),
+ ok.
+
+
+do_cast(Tag, Name, Request) when atom(Name) ->
+ Name ! {Tag, Request};
+do_cast(Tag, Pid, Request) when pid(Pid) ->
+ Pid ! {Tag, Request}.
+
+
+%% @spec reply(From::callerRef(), Reply::term()) -> Void
+%% @equiv gen_server:reply/2
+reply({To, Tag}, Reply) ->
+ catch To ! {Tag, Reply}.
+
+
+%%% ---------------------------------------------------
+%%% 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.
+%%% ---------------------------------------------------
+%%% @hidden
+init_it(Starter, self, Name, Mod, {CandidateNodes, Workers, Arg}, Options) ->
+ if CandidateNodes == [] ->
+ erlang:error(no_candidates);
+ true ->
+ init_it(Starter, self(), Name, Mod,
+ {CandidateNodes, Workers, Arg}, Options)
+ end;
+init_it(Starter,Parent,Name,Mod,{local_only, _}=Arg,Options) ->
+ Debug = debug_options(Name, Options),
+ reg_behaviour(),
+ case catch Mod:init(Arg) of
+ {stop, Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ ignore ->
+ proc_lib:init_ack(Starter, ignore),
+ exit(normal);
+ {'EXIT', Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ {ok, State} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ Server = #server{parent = Parent,
+ mod = Mod,
+ state = State,
+ debug = Debug},
+ loop(Server, local_only, #election{name = Name, mode = local});
+ Other ->
+ Error = {bad_return_value, Other},
+ proc_lib:init_ack(Starter, {error, Error}),
+ exit(Error)
+ end;
+init_it(Starter,Parent,Name,Mod,{CandidateNodes,Workers,Arg},Options) ->
+ Debug = debug_options(Name, Options),
+ reg_behaviour(),
+ AmCandidate = member(node(), CandidateNodes),
+ Election = init_election(CandidateNodes, Workers, #election{name = Name}),
+ case {catch Mod:init(Arg), AmCandidate} of
+ {{stop, Reason},_} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ {ignore,_} ->
+ proc_lib:init_ack(Starter, ignore),
+ exit(normal);
+ {{'EXIT', Reason},_} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ {{ok, State}, true} ->
+%%% NewE = broadcast(capture,Workers++(CandidateNodes -- [node()]),
+%%% Election),
+ proc_lib:init_ack(Starter, {ok, self()}),
+ begin_election(#server{parent = Parent,
+ mod = Mod,
+ state = State,
+ debug = Debug}, candidate, Election);
+ {{ok, State}, false} ->
+%%% NewE = broadcast(add_worker, CandidateNodes, Election),
+ proc_lib:init_ack(Starter, {ok, self()}),
+ begin_election(#server{parent = Parent,
+ mod = Mod,
+ state = State,
+ debug = Debug}, waiting_worker, Election);
+ Else ->
+ Error = {bad_return_value, Else},
+ proc_lib:init_ack(Starter, {error, Error}),
+ exit(Error)
+ end.
+
+reg_behaviour() ->
+ catch gproc:reg({p,l,behaviour}, ?MODULE).
+
+init_election(CandidateNodes, Workers, E) ->
+%%% dbg:tracer(),
+%%% dbg:tpl(?MODULE,lexcompare,[]),
+%%% dbg:p(self(),[m,c]),
+ AmCandidate = member(node(), CandidateNodes),
+ case AmCandidate of
+ true ->
+ E#election{mode = global,
+ candidate_nodes = CandidateNodes,
+ worker_nodes = Workers,
+ iteration = {[],
+ position(
+ node(),CandidateNodes)}};
+ false ->
+ E#election{mode = global,
+ candidate_nodes = CandidateNodes,
+ worker_nodes = Workers}
+ end.
+
+begin_election(#server{mod = Mod, state = State} = Server, candidate,
+ #election{candidate_nodes = Cands,
+ worker_nodes = Workers} = E) ->
+ case Cands of
+ [N] when N == node() ->
+ {ok, Synch, NewState} = Mod:elected(State, E),
+ NewE = broadcast({elect,Synch}, E),
+ loop(Server#server{state = NewState}, elected, NewE);
+ _ ->
+ NewE = broadcast(capture,Workers++(Cands -- [node()]), E),
+ safe_loop(Server, candidate, NewE)
+ end;
+begin_election(Server, waiting_worker, #election{candidate_nodes = Cands}=E) ->
+ NewE = broadcast(add_worker, Cands, E),
+ safe_loop(Server, waiting_worker, NewE).
+
+
+%%% ---------------------------------------------------
+%%% The MAIN loop.
+%%% ---------------------------------------------------
+
+
+safe_loop(#server{mod = Mod, state = State} = Server, Role,
+ #election{name = Name} = E) ->
+ receive
+ {system, From, Req} ->
+ #server{parent = Parent, debug = Debug} = Server,
+ sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
+ [safe, Server, Role, E]);
+ {'EXIT', _Parent, Reason} = Msg ->
+ terminate(Reason, Msg, Server, Role, E);
+ {leader,capture,Iteration,_Node,Candidate} ->
+ case Role of
+ candidate ->
+ NewE =
+ nodeup(node(Candidate),E),
+ case lexcompare(NewE#election.iteration,Iteration) of
+ less ->
+ Candidate !
+ {leader,accept,
+ NewE#election.iteration,self()},
+ safe_loop(Server, captured,
+ NewE#election{leader = Candidate});
+ greater ->
+ %% I'll get either an accept or DOWN
+ %% from Candidate later
+ safe_loop(Server, Role, NewE);
+ equal ->
+ safe_loop(Server, Role, NewE)
+ end;
+ captured ->
+ NewE = nodeup(node(Candidate), E),
+ safe_loop(Server, Role, NewE);
+ waiting_worker ->
+ NewE =
+ nodeup(node(Candidate),E),
+ safe_loop(Server, Role, NewE)
+ end;
+ {leader,add_worker,Worker} ->
+ NewE = nodeup(node(Worker), E),
+ safe_loop(Server, Role, NewE);
+ {leader,accept,Iteration,Candidate} ->
+ case Role of
+ candidate ->
+ NewE =
+ nodeup(node(Candidate),E),
+ {Captured,_} = Iteration,
+ NewIteration = % inherit all procs that have been
+ % accepted by Candidate
+ foldl(fun(C,Iter) ->
+ add_captured(Iter,C)
+ end,NewE#election.iteration,
+ [node(Candidate)|Captured]),
+ check_majority(NewE#election{
+ iteration = NewIteration}, Server);
+ captured ->
+ %% forward this to the leader
+ E#election.leader ! {leader,accept,Iteration,Candidate},
+ NewE = nodeup(node(Candidate), E),
+ safe_loop(Server, Role, NewE)
+ end;
+ {leader,elect,Synch,Candidate} ->
+ NewE =
+ case Role of
+ waiting_worker ->
+ nodeup(node(Candidate),
+ E#election{
+ leader = Candidate,
+ leadernode = node(Candidate)});
+ _ ->
+ nodeup(node(Candidate),
+ E#election{
+ leader = Candidate,
+ leadernode = node(Candidate),
+ iteration = {[],
+ position(
+ node(),
+ E#election.candidate_nodes)}
+ })
+ end,
+ {ok,NewState} = Mod:surrendered(State,Synch,NewE),
+ NewRole = case Role of
+ waiting_worker ->
+ worker;
+ _ ->
+ surrendered
+ end,
+ loop(Server#server{state = NewState}, NewRole, NewE);
+ {leader, local_only, Node, Candidate} ->
+ case lists:keysearch(node(Candidate), 2, E#election.monitored) of
+ {value, {Ref, N}} ->
+ NewE = down(Ref, {E#election.name,N},local_only,E),
+ io:format("local_only received from ~p~n"
+ "E0 = ~p~n"
+ "E1 = ~p~n", [Node, E, NewE]),
+ safe_after_down(Server, Role, NewE);
+ false ->
+ safe_loop(Server, Role, E)
+ end;
+ {'DOWN',Ref,process,{Name,_}=Who,Why} ->
+ NewE =
+ down(Ref,Who,Why,E),
+ safe_after_down(Server, Role, NewE)
+ end.
+
+safe_after_down(Server, Role, E) ->
+ case {Role,E#election.leader} of
+ {candidate,_} ->
+ check_majority(E, Server);
+ {captured,none} ->
+ check_majority(broadcast(capture,E), Server);
+ {waiting_worker,_} ->
+ safe_loop(Server, Role, E)
+ end.
+
+
+loop(#server{parent = Parent,
+ mod = Mod,
+ state = State,
+ debug = Debug} = Server, Role,
+ #election{mode = Mode, name = Name} = E) ->
+ Msg = receive
+
+ Input ->
+ Input
+ end,
+ case Msg of
+ {system, From, Req} ->
+ sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
+ [normal, Server, Role, E]);
+ {'EXIT', Parent, Reason} ->
+ terminate(Reason, Msg, Server, Role, E);
+ {leader, local_only, _, _Candidate} ->
+ loop(Server, Role, E);
+ LeaderMsg when element(1,LeaderMsg) == leader, Mode == local ->
+ Candidate = element(size(LeaderMsg), LeaderMsg),
+ Candidate ! {leader, local_only, node(), self()},
+ loop(Server, Role, E);
+ {leader,capture,_Iteration,_Node,Candidate} ->
+ NewE = nodeup(node(Candidate),E),
+ case Role of
+ R when R == surrendered; R == worker ->
+ loop(Server, Role, NewE);
+ elected ->
+ {ok,Synch,NewState} = Mod:elected(State,NewE),
+ Candidate ! {leader, elect, Synch, self()},
+ loop(Server#server{state = NewState}, Role, NewE)
+ end;
+ {leader,accept,_Iteration,Candidate} ->
+ NewE = nodeup(node(Candidate),E),
+ case Role of
+ surrendered ->
+ loop(Server, Role, NewE);
+ elected ->
+ {ok,Synch,NewState} = Mod:elected(State,NewE),
+ Candidate ! {leader, elect, Synch, self()},
+ loop(Server#server{state = NewState}, Role, NewE)
+ end;
+ {leader,elect,Synch,Candidate} ->
+ NewE =
+ case Role of
+ worker ->
+ nodeup(node(Candidate),
+ E#election{
+ leader = Candidate,
+ leadernode = node(Candidate)});
+ surrendered ->
+ nodeup(node(Candidate),
+ E#election{
+ leader = Candidate,
+ leadernode = node(Candidate),
+ iteration = {[],
+ position(
+ node(),
+ E#election.candidate_nodes)}
+ })
+ end,
+ {ok, NewState} = Mod:surrendered(State, Synch, NewE),
+ loop(Server#server{state = NewState}, Role, NewE);
+ {'DOWN',Ref,process,{Name,Node} = Who,Why} ->
+ #election{alive = PreviouslyAlive} = E,
+ NewE =
+ down(Ref,Who,Why,E),
+ case NewE#election.leader of
+ none ->
+ foreach(fun({_,From}) ->
+ reply(From,{error,leader_died})
+ end, E#election.buffered),
+ NewE1 = NewE#election{buffered = []},
+ case Role of
+ surrendered ->
+ check_majority(
+ broadcast(capture,NewE1), Server);
+ worker ->
+ safe_loop(Server, waiting_worker, NewE1)
+ end;
+ L when L == self() ->
+ case member(Node, PreviouslyAlive) of
+ true ->
+ case Mod:handle_DOWN(Node, State, E) of
+ {ok, NewState} ->
+ loop(Server#server{state = NewState},
+ Role, NewE);
+ {ok, Broadcast, NewState} ->
+ NewE1 = broadcast(
+ {from_leader,Broadcast}, NewE),
+ loop(Server#server{state = NewState},
+ Role, NewE1)
+ end;
+ false ->
+ loop(Server, Role, NewE)
+ end;
+ _ ->
+ loop(Server, Role, NewE)
+ end;
+ _Msg when Debug == [] ->
+ handle_msg(Msg, Server, Role, E);
+ _Msg ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ E#election.name, {in, Msg}),
+ handle_msg(Msg, Server#server{debug = Debug1}, Role, E)
+ end.
+
+%%-----------------------------------------------------------------
+%% Callback functions for system messages handling.
+%%-----------------------------------------------------------------
+
+%% @hidden
+system_continue(_Parent, Debug, [safe, Server, Role, E]) ->
+ safe_loop(Server#server{debug = Debug}, Role, E);
+system_continue(_Parent, Debug, [normal, Server, Role, E]) ->
+ loop(Server#server{debug = Debug}, Role, E).
+
+%% @hidden
+system_terminate(Reason, _Parent, Debug, [_Mode, Server, Role, E]) ->
+ terminate(Reason, [], Server#server{debug = Debug}, Role, E).
+
+%% @hidden
+system_code_change([Mode, Server, Role, E], _Module, OldVsn, Extra) ->
+ #server{mod = Mod, state = State} = Server,
+ case catch Mod:code_change(OldVsn, State, E, Extra) of
+ {ok, NewState} ->
+ NewServer = Server#server{state = NewState},
+ {ok, [Mode, NewServer, Role, E]};
+ {ok, NewState, NewE} ->
+ NewServer = Server#server{state = NewState},
+ {ok, [Mode, NewServer, Role, NewE]};
+ Else -> Else
+ end.
+
+%%-----------------------------------------------------------------
+%% Format debug messages. Print them as the call-back module sees
+%% them, not as the real erlang messages. Use trace for that.
+%%-----------------------------------------------------------------
+%% @hidden
+print_event(Dev, {in, Msg}, Name) ->
+ case Msg of
+ {'$gen_call', {From, _Tag}, Call} ->
+ io:format(Dev, "*DBG* ~p got local call ~p from ~w~n",
+ [Name, Call, From]);
+ {'$leader_call', {From, _Tag}, Call} ->
+ io:format(Dev, "*DBG* ~p got global call ~p from ~w~n",
+ [Name, Call, From]);
+ {'$gen_cast', Cast} ->
+ io:format(Dev, "*DBG* ~p got local cast ~p~n",
+ [Name, Cast]);
+ {'$leader_cast', Cast} ->
+ io:format(Dev, "*DBG* ~p got global cast ~p~n",
+ [Name, Cast]);
+ _ ->
+ io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
+ end;
+print_event(Dev, {out, Msg, To, State}, Name) ->
+ io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n",
+ [Name, Msg, To, State]);
+print_event(Dev, {noreply, State}, Name) ->
+ io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);
+print_event(Dev, Event, Name) ->
+ io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]).
+
+
+handle_msg({'$leader_call', From, Request} = Msg,
+ #server{mod = Mod, state = State} = Server, elected = Role, E) ->
+ case catch Mod:handle_leader_call(Request, From, State, E) of
+ {reply, Reply, NState} ->
+ NewServer = reply(From, {leader,reply,Reply},
+ Server#server{state = NState}, Role, E),
+ loop(NewServer, Role, E);
+ {reply, Reply, Broadcast, NState} ->
+ NewE = broadcast({from_leader,Broadcast}, E),
+ NewServer = reply(From, {leader,reply,Reply},
+ Server#server{state = NState}, Role,
+ NewE),
+ loop(NewServer, Role, NewE);
+ {noreply, NState} = Reply ->
+ NewServer = handle_debug(Server#server{state = NState},
+ Role, E, Reply),
+ loop(NewServer, Role, E);
+ {stop, Reason, Reply, NState} ->
+ {'EXIT', R} =
+ (catch terminate(Reason, Msg,
+ Server#server{state = NState},
+ Role, E)),
+ reply(From, Reply),
+ exit(R);
+ Other ->
+ handle_common_reply(Other, Msg, Server, Role, E)
+ end;
+handle_msg({'$leader_call', From, Request} = Msg,
+ #server{mod = Mod, state = State} = Server, Role,
+ #election{mode = local} = E) ->
+ Reply = (catch Mod:handle_leader_call(Request,From,State,E)),
+ handle_call_reply(Reply, Msg, Server, Role, E);
+%%% handle_common_reply(Reply, Msg, Server, Role, E);
+handle_msg({'$leader_cast', Cast} = Msg,
+ #server{mod = Mod, state = State} = Server, Role,
+ #election{mode = local} = E) ->
+ Reply = (catch Mod:handle_leader_cast(Cast,State,E)),
+ handle_common_reply(Reply, Msg, Server, Role, E);
+handle_msg({'$leader_cast', Cast} = Msg,
+ #server{mod = Mod, state = State} = Server, elected = Role, E) ->
+ Reply = (catch Mod:handle_leader_cast(Cast, State, E)),
+ handle_common_reply(Reply, Msg, Server, Role, E);
+handle_msg({from_leader, Cmd} = Msg,
+ #server{mod = Mod, state = State} = Server, Role, E) ->
+ handle_common_reply(catch Mod:from_leader(Cmd, State, E),
+ Msg, Server, Role, E);
+handle_msg({'$leader_call', From, Request}, Server, Role,
+ #election{buffered = Buffered, leader = Leader} = E) ->
+ Ref = make_ref(),
+ Leader ! {'$leader_call', {self(),Ref}, Request},
+ NewBuffered = [{Ref,From}|Buffered],
+ loop(Server, Role, E#election{buffered = NewBuffered});
+handle_msg({Ref, {leader,reply,Reply}}, Server, Role,
+ #election{buffered = Buffered} = E) ->
+ {value, {_,From}} = keysearch(Ref,1,Buffered),
+ NewServer = reply(From, {leader,reply,Reply}, Server, Role,
+ E#election{buffered = keydelete(Ref,1,Buffered)}),
+ loop(NewServer, Role, E);
+handle_msg({'$gen_call', From, Request} = Msg,
+ #server{mod = Mod, state = State} = Server, Role, E) ->
+ Reply = (catch Mod:handle_call(Request, From, State)),
+ handle_call_reply(Reply, Msg, Server, Role, E);
+handle_msg({'$gen_cast',Msg} = Cast,
+ #server{mod = Mod, state = State} = Server, Role, E) ->
+ handle_common_reply(catch Mod:handle_cast(Msg, State),
+ Cast, Server, Role, E);
+handle_msg(Msg,
+ #server{mod = Mod, state = State} = Server, Role, E) ->
+ handle_common_reply(catch Mod:handle_info(Msg, State),
+ Msg, Server, Role, E).
+
+
+handle_call_reply(CB_reply, {_, From, _Request} = Msg, Server, Role, E) ->
+ case CB_reply of
+ {reply, Reply, NState} ->
+ NewServer = reply(From, Reply,
+ Server#server{state = NState}, Role, E),
+ loop(NewServer, Role, E);
+ {noreply, NState} = Reply ->
+ NewServer = handle_debug(Server#server{state = NState},
+ Role, E, Reply),
+ loop(NewServer, Role, E);
+ {activate, Cands, Workers, Reply, NState}
+ when E#election.mode == local ->
+ NewRole = case member(node(), Cands) of
+ true -> candidate;
+ false -> waiting_worker
+ end,
+ reply(From, Reply),
+ NServer = Server#server{state = NState},
+ NewE = init_election(Cands, Workers, E),
+ io:format("activating: NewE = ~p~n", [NewE]),
+ begin_election(NServer, NewRole, NewE);
+ {stop, Reason, Reply, NState} ->
+ {'EXIT', R} =
+ (catch terminate(Reason, Msg, Server#server{state = NState},
+ Role, E)),
+ reply(From, Reply),
+ exit(R);
+ Other ->
+ handle_common_reply(Other, Msg, Server, Role, E)
+ end.
+
+
+handle_common_reply(Reply, Msg, Server, Role, E) ->
+ case Reply of
+ {ok, NState} ->
+ NewServer = handle_debug(Server#server{state = NState},
+ Role, E, Reply),
+ loop(NewServer, Role, E);
+ {ok, Broadcast, NState} ->
+ NewE = broadcast({from_leader,Broadcast}, E),
+ NewServer = handle_debug(Server#server{state = NState},
+ Role, E, Reply),
+ loop(NewServer, Role, NewE);
+ {stop, Reason, NState} ->
+ terminate(Reason, Msg, Server#server{state = NState}, Role, E);
+ {'EXIT', Reason} ->
+ terminate(Reason, Msg, Server, Role, E);
+ _ ->
+ terminate({bad_return_value, Reply}, Msg, Server, Role, E)
+ end.
+
+
+reply({To, Tag}, Reply, #server{state = State} = Server, Role, E) ->
+ reply({To, Tag}, Reply),
+ handle_debug(Server, Role, E, {out, Reply, To, State}).
+
+
+handle_debug(#server{debug = []} = Server, _Role, _E, _Event) ->
+ Server;
+handle_debug(#server{debug = Debug} = Server, _Role, E, Event) ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ E#election.name, Event),
+ Server#server{debug = Debug1}.
+
+%%% ---------------------------------------------------
+%%% Terminate the server.
+%%% ---------------------------------------------------
+
+terminate(Reason, Msg, #server{mod = Mod,
+ state = State,
+ debug = Debug}, _Role,
+ #election{name = Name}) ->
+ case catch Mod:terminate(Reason, State) of
+ {'EXIT', R} ->
+ error_info(R, Name, Msg, State, Debug),
+ exit(R);
+ _ ->
+ case Reason of
+ normal ->
+ exit(normal);
+ shutdown ->
+ exit(shutdown);
+ _ ->
+ error_info(Reason, Name, Msg, State, Debug),
+ exit(Reason)
+ end
+ end.
+
+%% Maybe we shouldn't do this? We have the crash report...
+error_info(Reason, Name, Msg, State, Debug) ->
+ format("** Generic leader ~p terminating \n"
+ "** Last message in was ~p~n"
+ "** When Server state == ~p~n"
+ "** Reason for termination == ~n** ~p~n",
+ [Name, Msg, State, Reason]),
+ sys:print_log(Debug),
+ ok.
+
+%%% ---------------------------------------------------
+%%% Misc. functions.
+%%% ---------------------------------------------------
+
+opt(Op, [{Op, Value}|_]) ->
+ {ok, Value};
+opt(Op, [_|Options]) ->
+ opt(Op, Options);
+opt(_, []) ->
+ false.
+
+debug_options(Name, Opts) ->
+ case opt(debug, Opts) of
+ {ok, Options} -> dbg_options(Name, Options);
+ _ -> dbg_options(Name, [])
+ end.
+
+dbg_options(Name, []) ->
+ Opts =
+ case init:get_argument(generic_debug) of
+ error ->
+ [];
+ _ ->
+ [log, statistics]
+ end,
+ dbg_opts(Name, Opts);
+dbg_options(Name, Opts) ->
+ dbg_opts(Name, Opts).
+
+dbg_opts(Name, Opts) ->
+ case catch sys:debug_options(Opts) of
+ {'EXIT',_} ->
+ format("~p: ignoring erroneous debug options - ~p~n",
+ [Name, Opts]),
+ [];
+ Dbg ->
+ Dbg
+ end.
+
+%%-----------------------------------------------------------------
+%% Status information
+%%-----------------------------------------------------------------
+%% @hidden
+format_status(Opt, StatusData) ->
+ [PDict, SysState, Parent, Debug, [_Mode, Server, _Role, E]] = StatusData,
+ Header = lists:concat(["Status for generic server ", E#election.name]),
+ Log = sys:get_debug(log, Debug, []),
+ #server{mod = Mod, state = State} = Server,
+ Specific =
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ case catch apply(Mod, format_status, [Opt, [PDict, State]]) of
+ {'EXIT', _} -> [{data, [{"State", State}]}];
+ Else -> Else
+ end;
+ _ ->
+ [{data, [{"State", State}]}]
+ end,
+ [{header, Header},
+ {data, [{"Status", SysState},
+ {"Parent", Parent},
+ {"Logged events", Log}]} |
+ Specific].
+
+
+
+
+broadcast(Msg, #election{monitored = Monitored} = E) ->
+ %% When broadcasting the first time, we broadcast to all candidate nodes,
+ %% using broadcast/3. This function is used for subsequent broadcasts,
+ %% and we make sure only to broadcast to already known nodes.
+ %% It's the responsibility of new nodes to make themselves known through
+ %% a wider broadcast.
+ ToNodes = [N || {_,N} <- Monitored],
+ broadcast(Msg, ToNodes, E).
+
+broadcast(capture, ToNodes, #election{monitored = Monitored} = E) ->
+ ToMonitor = [N || N <- ToNodes,
+ not(keymember(N,2,Monitored))],
+ NewE =
+ foldl(fun(Node,Ex) ->
+ Ref = erlang:monitor(
+ process,{Ex#election.name,Node}),
+ Ex#election{monitored = [{Ref,Node}|
+ Ex#election.monitored]}
+ end,E,ToMonitor),
+ foreach(
+ fun(Node) ->
+ {NewE#election.name,Node} !
+ {leader,capture,NewE#election.iteration,node(),self()}
+ end,ToNodes),
+ NewE;
+broadcast({elect,Synch},ToNodes,E) ->
+ foreach(
+ fun(Node) ->
+ {E#election.name,Node} ! {leader,elect,Synch,self()}
+ end,ToNodes),
+ E;
+broadcast({from_leader, Msg}, ToNodes, E) ->
+ foreach(
+ fun(Node) ->
+ {E#election.name,Node} ! {from_leader, Msg}
+ end,ToNodes),
+ E;
+broadcast(add_worker, ToNodes, E) ->
+ foreach(
+ fun(Node) ->
+ {E#election.name,Node} ! {leader, add_worker, self()}
+ end,ToNodes),
+ E.
+
+
+
+check_majority(E, Server) ->
+ {Captured,_} = E#election.iteration,
+ AcceptMeAsLeader = length(Captured) + 1, % including myself
+ NrCandidates = length(E#election.candidate_nodes),
+ NrDown = E#election.down,
+ if AcceptMeAsLeader > NrCandidates/2 ->
+ NewE = E#election{leader = self(), leadernode = node()},
+ {ok,Synch,NewState} =
+ (Server#server.mod):elected(Server#server.state, NewE),
+ NewE1 = broadcast({elect,Synch}, NewE),
+ loop(Server#server{state = NewState}, elected, NewE1);
+ AcceptMeAsLeader+length(NrDown) == NrCandidates ->
+ NewE = E#election{leader = self(), leadernode = node()},
+ {ok,Synch,NewState} =
+ (Server#server.mod):elected(Server#server.state, NewE),
+ NewE1 = broadcast({elect,Synch}, NewE),
+ loop(Server#server{state = NewState}, elected, NewE1);
+ true ->
+ safe_loop(Server, candidate, E)
+ end.
+
+
+down(Ref,_Who,Why,E) ->
+ case lists:keysearch(Ref,1,E#election.monitored) of
+ {value, {_,Node}} ->
+ NewMonitored = if Why == local_only -> E#election.monitored;
+ true ->
+ E#election.monitored -- [{Ref,Node}]
+ end,
+ {Captured,Pos} = E#election.iteration,
+ case Node == E#election.leadernode of
+ true ->
+ E#election{leader = none,
+ leadernode = none,
+ iteration = {Captured -- [Node],
+ Pos}, % TAKE CARE !
+ down = [Node|E#election.down],
+ alive = E#election.alive -- [Node],
+ monitored = NewMonitored};
+ false ->
+ Down = case member(Node,E#election.candidate_nodes) of
+ true ->
+ [Node|E#election.down];
+ false ->
+ E#election.down
+ end,
+ E#election{iteration = {Captured -- [Node],
+ Pos}, % TAKE CARE !
+ down = Down,
+ alive = E#election.alive -- [Node],
+ monitored = NewMonitored}
+ end
+ end.
+
+
+
+%% position of element counted from end of the list
+%%
+position(X,[Head|Tail]) ->
+ case X==Head of
+ true ->
+ length(Tail);
+ false ->
+ position(X,Tail)
+ end.
+
+%% This is a multi-level comment
+%% This is the second line of the comment
+lexcompare({C1,P1},{C2,P2}) ->
+ lexcompare([{length(C1),length(C2)},{P1,P2}]).
+
+lexcompare([]) ->
+ equal;
+lexcompare([{X,Y}|Rest]) ->
+ if X less;
+ X==Y -> lexcompare(Rest);
+ X>Y -> greater
+ end.
+
+add_captured({Captured,Pos}, CandidateNode) ->
+ {[CandidateNode|[ Node || Node <- Captured,
+ Node =/= CandidateNode ]], Pos}.
+
+nodeup(Node, #election{monitored = Monitored,
+ alive = Alive,
+ down = Down} = E) ->
+ %% make sure process is monitored from now on
+ case [ N || {_,N}<-Monitored, N==Node] of
+ [] ->
+ Ref = erlang:monitor(process,{E#election.name,Node}),
+ E#election{down = Down -- [Node],
+ alive = [Node | Alive],
+ monitored = [{Ref,Node}|Monitored]};
+ _ -> % already monitored, thus not in down
+ E#election{alive = [Node | [N || N <- Alive,
+ N =/= Node]]}
+ end.
+
diff --git a/patches/kernel/application_master.erl b/patches/kernel/application_master.erl
new file mode 100644
index 0000000..fa3c609
--- /dev/null
+++ b/patches/kernel/application_master.erl
@@ -0,0 +1,428 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(application_master).
+
+%% External exports
+-export([start_link/2, start_type/0, stop/1]).
+-export([get_child/1]).
+
+%% Internal exports
+-export([init/4, start_it/4]).
+
+-include("application_master.hrl").
+
+-record(state, {child, appl_data, children = [], procs = 0, gleader}).
+
+%%-----------------------------------------------------------------
+%% Func: start_link/1
+%% Args: ApplData = record(appl_data)
+%% Purpose: Starts an application master for the application.
+%% Called from application_controller. (The application is
+%% also started).
+%% Returns: {ok, Pid} | {error, Reason} (Pid is unregistered)
+%%-----------------------------------------------------------------
+start_link(ApplData, Type) ->
+ Parent = whereis(application_controller),
+ proc_lib:start_link(application_master, init,
+ [Parent, self(), ApplData, Type]).
+
+start_type() ->
+ group_leader() ! {start_type, self()},
+ receive
+ {start_type, Type} ->
+ Type
+ after 5000 ->
+ {error, timeout}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: stop/1
+%% Purpose: Stops the application. This function makes sure
+%% that all processes belonging to the applicication is
+%% stopped (shutdown or killed). The application master
+%% is also stopped.
+%% Returns: ok
+%%-----------------------------------------------------------------
+stop(AppMaster) -> call(AppMaster, stop).
+
+%%-----------------------------------------------------------------
+%% Func: get_child/1
+%% Purpose: Get the topmost supervisor of an application.
+%% Returns: {pid(), App}
+%%-----------------------------------------------------------------
+get_child(AppMaster) -> call(AppMaster, get_child).
+
+call(AppMaster, Req) ->
+ Tag = make_ref(),
+ Ref = erlang:monitor(process, AppMaster),
+ AppMaster ! {Req, Tag, self()},
+ receive
+ {'DOWN', Ref, process, _, _Info} ->
+ ok;
+ {Tag, Res} ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, process, _, _Info} ->
+ Res
+ after 0 ->
+ Res
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% The logical and physical process structrure is as follows:
+%%%
+%%% logical physical
+%%%
+%%% -------- --------
+%%% |AM(GL)| |AM(GL)|
+%%% -------- --------
+%%% | |
+%%% -------- --------
+%%% |Appl P| | X |
+%%% -------- --------
+%%% |
+%%% --------
+%%% |Appl P|
+%%% --------
+%%%
+%%% Where AM(GL) == Application Master (Group Leader)
+%%% Appl P == The application specific root process (child to AM)
+%%% X == A special 'invisible' process
+%%% The reason for not using the logical structrure is that
+%%% the application start function is synchronous, and
+%%% that the AM is GL. This means that if AM executed the start
+%%% function, and this function uses spawn_request/1
+%%% or io, deadlock would occur. Therefore, this function is
+%%% executed by the process X. Also, AM needs three loops;
+%%% init_loop (waiting for the start function to return)
+%%% main_loop
+%%% terminate_loop (waiting for the process to die)
+%%% In each of these loops, io and other requests are handled.
+%%%-----------------------------------------------------------------
+%%% Internal functions
+%%%-----------------------------------------------------------------
+init(Parent, Starter, ApplData, Type) ->
+ link(Parent),
+ process_flag(trap_exit, true),
+ gen:reg_behaviour(application),
+ OldGleader = group_leader(),
+ group_leader(self(), self()),
+ %% Insert ourselves as master for the process. This ensures that
+ %% the processes in the application can use get_env/1 at startup.
+ Name = ApplData#appl_data.name,
+ ets:insert(ac_tab, {{application_master, Name}, self()}),
+ State = #state{appl_data = ApplData, gleader = OldGleader},
+ case start_it(State, Type) of
+ {ok, Pid} -> % apply(M,F,A) returned ok
+ set_timer(ApplData#appl_data.maxT),
+ unlink(Starter),
+ proc_lib:init_ack(Starter, {ok,self()}),
+ main_loop(Parent, State#state{child = Pid});
+ {error, Reason} -> % apply(M,F,A) returned error
+ exit(Reason);
+ Else -> % apply(M,F,A) returned erroneous
+ exit(Else)
+ end.
+
+%%-----------------------------------------------------------------
+%% We want to start the new application synchronously, but we still
+%% want to handle io requests. So we spawn off a new process that
+%% performs the apply, and we wait for a start ack.
+%%-----------------------------------------------------------------
+start_it(State, Type) ->
+ Tag = make_ref(),
+ Pid = spawn_link(application_master, start_it, [Tag, State, self(), Type]),
+ init_loop(Pid, Tag, State, Type).
+
+
+%%-----------------------------------------------------------------
+%% These are the three different loops executed by the application_
+%% master
+%%-----------------------------------------------------------------
+init_loop(Pid, Tag, State, Type) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ init_loop(Pid, Tag, State, Type);
+ {Tag, Res} ->
+ Res;
+ {'EXIT', Pid, Reason} ->
+ {error, Reason};
+ {start_type, From} ->
+ From ! {start_type, Type},
+ init_loop(Pid, Tag, State, Type);
+ Other ->
+ NewState = handle_msg(Other, State),
+ init_loop(Pid, Tag, NewState, Type)
+ end.
+
+main_loop(Parent, State) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ main_loop(Parent, State);
+ {'EXIT', Parent, Reason} ->
+ terminate(Reason, State);
+ {'EXIT', Child, Reason} when State#state.child =:= Child ->
+ terminate(Reason, State#state{child=undefined});
+ {'EXIT', _, timeout} ->
+ terminate(normal, State);
+ {'EXIT', Pid, _Reason} ->
+ Children = lists:delete(Pid, State#state.children),
+ Procs = State#state.procs - 1,
+ main_loop(Parent, State#state{children=Children, procs=Procs});
+ {start_type, From} ->
+ From ! {start_type, local},
+ main_loop(Parent, State);
+ Other ->
+ NewState = handle_msg(Other, State),
+ main_loop(Parent, NewState)
+ end.
+
+terminate_loop(Child, State) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ terminate_loop(Child, State);
+ {'EXIT', Child, _} ->
+ ok;
+ Other ->
+ NewState = handle_msg(Other, State),
+ terminate_loop(Child, NewState)
+ end.
+
+
+%%-----------------------------------------------------------------
+%% The Application Master is linked to *all* processes in the group
+%% (application).
+%%-----------------------------------------------------------------
+handle_msg({get_child, Tag, From}, State) ->
+ From ! {Tag, get_child_i(State#state.child)},
+ State;
+handle_msg({stop, Tag, From}, State) ->
+ catch terminate(normal, State),
+ From ! {Tag, ok},
+ exit(normal);
+handle_msg(_, State) ->
+ State.
+
+
+terminate(Reason, State) ->
+ terminate_child(State#state.child, State),
+ kill_children(State#state.children),
+ exit(Reason).
+
+
+
+
+%%======================================================================
+%%======================================================================
+%%======================================================================
+%% This is the process X above...
+%%======================================================================
+%%======================================================================
+%%======================================================================
+
+%%======================================================================
+%% Start an application.
+%% If the start_phases is defined in the .app file, the application is
+%% to be started in one or several start phases.
+%% If the Module in the mod-key is set to application_starter then
+%% the generic help module application_starter is used to control
+%% the start.
+%%======================================================================
+
+start_it(Tag, State, From, Type) ->
+ process_flag(trap_exit, true),
+ ApplData = State#state.appl_data,
+ case {ApplData#appl_data.phases, ApplData#appl_data.mod} of
+ {undefined, _} ->
+ start_it_old(Tag, From, Type, ApplData);
+ {Phases, {application_starter, [M, A]}} ->
+ start_it_new(Tag, From, Type, M, A, Phases,
+ [ApplData#appl_data.name]);
+ {Phases, {M, A}} ->
+ start_it_new(Tag, From, Type, M, A, Phases,
+ [ApplData#appl_data.name]);
+ {OtherP, OtherM} ->
+ From ! {Tag, {error, {bad_keys, {{mod, OtherM},
+ {start_phases, OtherP}}}}}
+ end.
+
+
+%%%-----------------------------------------------------
+%%% No start phases are defined
+%%%-----------------------------------------------------
+start_it_old(Tag, From, Type, ApplData) ->
+ {M,A} = ApplData#appl_data.mod,
+ case catch M:start(Type, A) of
+ {ok, Pid} ->
+ link(Pid),
+ {ok, self()},
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, []);
+ {ok, Pid, AppState} ->
+ link(Pid),
+ {ok, self()},
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, AppState);
+ {'EXIT', normal} ->
+ From ! {Tag, {error, {{'EXIT',normal},{M,start,[Type,A]}}}};
+ {error, Reason} ->
+ From ! {Tag, {error, {Reason, {M,start,[Type,A]}}}};
+ Other ->
+ From ! {Tag, {error, {bad_return,{{M,start,[Type,A]},Other}}}}
+ end.
+
+
+%%%-----------------------------------------------------
+%%% Start phases are defined
+%%%-----------------------------------------------------
+start_it_new(Tag, From, Type, M, A, Phases, Apps) ->
+ case catch start_the_app(Type, M, A, Phases, Apps) of
+ {ok, Pid, AppState} ->
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, AppState);
+ Error ->
+ From ! {Tag, Error}
+ end.
+
+
+%%%=====================================================
+%%% Start the application in the defined phases,
+%%% but first the supervisors are starter.
+%%%=====================================================
+start_the_app(Type, M, A, Phases, Apps) ->
+ case start_supervisor(Type, M, A) of
+ {ok, Pid, AppState} ->
+ link(Pid),
+ case application_starter:start(Phases, Type, Apps) of
+ ok ->
+ {ok, Pid, AppState};
+ Error2 ->
+ unlink(Pid),
+ Error2
+ end;
+ Error ->
+ Error
+ end.
+
+%%%-------------------------------------------------------------
+%%% Start the supervisors
+%%%-------------------------------------------------------------
+start_supervisor(Type, M, A) ->
+ case catch M:start(Type, A) of
+ {ok, Pid} ->
+ {ok, Pid, []};
+ {ok, Pid, AppState} ->
+ {ok, Pid, AppState};
+ {error, Reason} ->
+ {error, {Reason, {M, start, [Type, A]}}};
+ {'EXIT', normal} ->
+ {error, {{'EXIT', normal}, {M, start, [Type, A]}}};
+ Other ->
+ {error, {bad_return, {{M, start, [Type, A]}, Other}}}
+ end.
+
+
+
+
+%%======================================================================
+%%
+%%======================================================================
+
+loop_it(Parent, Child, Mod, AppState) ->
+ receive
+ {Parent, get_child} ->
+ Parent ! {self(), Child, Mod},
+ loop_it(Parent, Child, Mod, AppState);
+ {Parent, terminate} ->
+ NewAppState = prep_stop(Mod, AppState),
+ exit(Child, shutdown),
+ receive
+ {'EXIT', Child, _} -> ok
+ end,
+ catch Mod:stop(NewAppState),
+ exit(normal);
+ {'EXIT', Parent, Reason} ->
+ NewAppState = prep_stop(Mod, AppState),
+ exit(Child, Reason),
+ receive
+ {'EXIT', Child, Reason2} ->
+ exit(Reason2)
+ end,
+ catch Mod:stop(NewAppState);
+ {'EXIT', Child, Reason} -> % forward *all* exit reasons (inc. normal)
+ NewAppState = prep_stop(Mod, AppState),
+ catch Mod:stop(NewAppState),
+ exit(Reason);
+ _ ->
+ loop_it(Parent, Child, Mod, AppState)
+ end.
+
+prep_stop(Mod, AppState) ->
+ case catch Mod:prep_stop(AppState) of
+ {'EXIT', {undef, _}} ->
+ AppState;
+ {'EXIT', Reason} ->
+ error_logger:error_report([{?MODULE, shutdown_error},
+ {Mod, {prep_stop, [AppState]}},
+ {error_info, Reason}]),
+ AppState;
+ NewAppState ->
+ NewAppState
+ end.
+
+get_child_i(Child) ->
+ Child ! {self(), get_child},
+ receive
+ {Child, GrandChild, Mod} -> {GrandChild, Mod}
+ end.
+
+terminate_child_i(Child, State) ->
+ Child ! {self(), terminate},
+ terminate_loop(Child, State).
+
+%% Try to shutdown the child gently
+terminate_child(undefined, _) -> ok;
+terminate_child(Child, State) ->
+ terminate_child_i(Child, State).
+
+kill_children(Children) ->
+ lists:foreach(fun(Pid) -> exit(Pid, kill) end, Children),
+ kill_all_procs().
+
+kill_all_procs() ->
+ kill_all_procs_1(processes(), self(), 0).
+
+kill_all_procs_1([Self|Ps], Self, N) ->
+ kill_all_procs_1(Ps, Self, N);
+kill_all_procs_1([P|Ps], Self, N) ->
+ case process_info(P, group_leader) of
+ {group_leader,Self} ->
+ exit(P, kill),
+ kill_all_procs_1(Ps, Self, N+1);
+ _ ->
+ kill_all_procs_1(Ps, Self, N)
+ end;
+kill_all_procs_1([], _, 0) -> ok;
+kill_all_procs_1([], _, _) -> kill_all_procs().
+
+set_timer(infinity) -> ok;
+set_timer(Time) -> timer:exit_after(Time, timeout).
diff --git a/patches/kernel/kernel.app.src b/patches/kernel/kernel.app.src
new file mode 100644
index 0000000..011f743
--- /dev/null
+++ b/patches/kernel/kernel.app.src
@@ -0,0 +1,110 @@
+%% This is an -*- erlang -*- file.
+{application, kernel,
+ [
+ {description, "ERTS CXC 138 10"},
+ {vsn, "%VSN%"},
+ {modules, [application,
+ application_controller,
+ application_master,
+ application_starter,
+ auth,
+ code,
+ code_aux,
+ packages,
+ code_server,
+ dist_util,
+ erl_boot_server,
+ erl_distribution,
+ erl_prim_loader,
+ erl_reply,
+ erlang,
+ error_handler,
+ error_logger,
+ file,
+ file_server,
+ file_io_server,
+ prim_file,
+ global,
+ global_group,
+ global_search,
+ gproc,
+ gen_leader,
+ group,
+ heart,
+ hipe_unified_loader,
+ inet6_tcp,
+ inet6_tcp_dist,
+ inet6_udp,
+ inet_config,
+ inet_hosts,
+ inet_gethost_native,
+ inet_tcp_dist,
+ init,
+ kernel,
+ kernel_config,
+ net,
+ net_adm,
+ net_kernel,
+ os,
+ ram_file,
+ rpc,
+ user,
+ user_drv,
+ user_sup,
+ disk_log,
+ disk_log_1,
+ disk_log_server,
+ disk_log_sup,
+ dist_ac,
+ erl_ddll,
+ erl_epmd,
+ erts_debug,
+ gen_tcp,
+ gen_udp,
+ gen_sctp,
+ prim_inet,
+ inet,
+ inet_db,
+ inet_dns,
+ inet_parse,
+ inet_res,
+ inet_tcp,
+ inet_udp,
+ inet_sctp,
+ pg2,
+ seq_trace,
+ wrap_log_reader,
+ zlib,
+ otp_ring0]},
+ {registered, [application_controller,
+ erl_reply,
+ auth,
+ boot_server,
+ code_server,
+ disk_log_server,
+ disk_log_sup,
+ erl_prim_loader,
+ error_logger,
+ file_server_2,
+ fixtable_server,
+ global_group,
+ global_name_server,
+ gproc,
+ heart,
+ init,
+ kernel_config,
+ kernel_sup,
+ net_kernel,
+ net_sup,
+ rex,
+ user,
+ os_server,
+ ddll_server,
+ erl_epmd,
+ inet_db,
+ pg2]},
+ {applications, []},
+ {env, [{error_logger, tty}]},
+ {mod, {kernel, []}}
+ ]
+}.
diff --git a/patches/kernel/kernel.erl b/patches/kernel/kernel.erl
new file mode 100644
index 0000000..f39e117
--- /dev/null
+++ b/patches/kernel/kernel.erl
@@ -0,0 +1,306 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(kernel).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, init/1, stop/1]).
+-export([config_change/3]).
+
+%%%-----------------------------------------------------------------
+%%% The kernel is the first application started.
+%%% Callback functions for the kernel application.
+%%%-----------------------------------------------------------------
+start(_, []) ->
+ {ok, _} = gproc:start_local(),
+ case supervisor:start_link({local, kernel_sup}, kernel, []) of
+ {ok, Pid} ->
+ Type = get_error_logger_type(),
+ error_logger:swap_handler(Type),
+ {ok, Pid, []};
+ Error -> Error
+ end.
+
+stop(_State) ->
+ ok.
+
+%%-------------------------------------------------------------------
+%% Some configuration parameters for kernel are changed
+%%-------------------------------------------------------------------
+config_change(Changed, New, Removed) ->
+ do_distribution_change(Changed, New, Removed),
+ do_global_groups_change(Changed, New, Removed),
+ ok.
+
+get_error_logger_type() ->
+ case application:get_env(kernel, error_logger) of
+ {ok, tty} -> tty;
+ {ok, {file, File}} when is_list(File) -> {logfile, File};
+ {ok, false} -> false;
+ {ok, silent} -> silent;
+ undefined -> tty; % default value
+ {ok, Bad} -> exit({bad_config, {kernel, {error_logger, Bad}}})
+ end.
+
+%%%-----------------------------------------------------------------
+%%% The process structure in kernel is as shown in the figure.
+%%%
+%%% ---------------
+%%% | kernel_sup (A)|
+%%% ---------------
+%%% |
+%%% -------------------------------
+%%% | | |
+%%% ------------- -------------
+%%% (file,code, | erl_dist (A)| | safe_sup (1)|
+%%% rpc, ...) ------------- -------------
+%%% | |
+%%% (net_kernel, (disk_log, pg2,
+%%% auth, ...) ...)
+%%%
+%%% The rectangular boxes are supervisors. All supervisors except
+%%% for kernel_safe_sup terminates the enitre erlang node if any of
+%%% their children dies. Any child that can't be restarted in case
+%%% of failure must be placed under one of these supervisors. Any
+%%% other child must be placed under safe_sup. These children may
+%%% be restarted. Be aware that if a child is restarted the old state
+%%% and all data will be lost.
+%%%-----------------------------------------------------------------
+%%% Callback functions for the kernel_sup supervisor.
+%%%-----------------------------------------------------------------
+
+init([]) ->
+ SupFlags = {one_for_all, 0, 1},
+
+ Config = {kernel_config,
+ {kernel_config, start_link, []},
+ permanent, 2000, worker, [kernel_config]},
+ Code = {code_server,
+ {code, start_link, get_code_args()},
+ permanent, 2000, worker, [code]},
+ File = {file_server_2,
+ {file_server, start_link, []},
+ permanent, 2000, worker,
+ [file, file_server, file_io_server, prim_file]},
+ User = {user,
+ {user_sup, start, []},
+ temporary, 2000, supervisor, [user_sup]},
+
+ case init:get_argument(mode) of
+ {ok, [["minimal"]]} ->
+
+ SafeSupervisor = {kernel_safe_sup,
+ {supervisor, start_link,
+ [{local, kernel_safe_sup}, ?MODULE, safe]},
+ permanent, infinity, supervisor, [?MODULE]},
+
+ {ok, {SupFlags,
+ [File, Code, User,
+ Config, SafeSupervisor]}};
+ _ ->
+ Rpc = {rex, {rpc, start_link, []},
+ permanent, 2000, worker, [rpc]},
+ Global = {global_name_server, {global, start_link, []},
+ permanent, 2000, worker, [global]},
+ Glo_grp = {global_group, {global_group,start_link,[]},
+ permanent, 2000, worker, [global_group]},
+ InetDb = {inet_db, {inet_db, start_link, []},
+ permanent, 2000, worker, [inet_db]},
+ NetSup = {net_sup, {erl_distribution, start_link, []},
+ permanent, infinity, supervisor,[erl_distribution]},
+ DistAC = start_dist_ac(),
+
+ GProc = {gproc, {gproc, go_global, []},
+ permanent, 3000, worker, [gproc]},
+
+ Timer = start_timer(),
+
+ SafeSupervisor = {kernel_safe_sup,
+ {supervisor, start_link,
+ [{local, kernel_safe_sup}, ?MODULE, safe]},
+ permanent, infinity, supervisor, [?MODULE]},
+
+ {ok, {SupFlags,
+ [Rpc, Global, InetDb | DistAC] ++
+ [NetSup, Glo_grp, File, Code,
+ User, Config, GProc, SafeSupervisor] ++ Timer}}
+ end;
+
+init(safe) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Boot = start_boot_server(),
+ DiskLog = start_disk_log(),
+ Pg2 = start_pg2(),
+ {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
+
+get_code_args() ->
+ case init:get_argument(nostick) of
+ {ok, [[]]} -> [[nostick]];
+ _ -> []
+ end.
+
+start_dist_ac() ->
+ Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}],
+ case application:get_env(kernel, start_dist_ac) of
+ {ok, true} -> Spec;
+ {ok, false} -> [];
+ undefined ->
+ case application:get_env(kernel, distributed) of
+ {ok, _} -> Spec;
+ _ -> []
+ end
+ end.
+
+start_boot_server() ->
+ case application:get_env(kernel, start_boot_server) of
+ {ok, true} ->
+ Args = get_boot_args(),
+ [{boot_server, {erl_boot_server, start_link, [Args]}, permanent,
+ 1000, worker, [erl_boot_server]}];
+ _ ->
+ []
+ end.
+
+get_boot_args() ->
+ case application:get_env(kernel, boot_server_slaves) of
+ {ok, Slaves} -> Slaves;
+ _ -> []
+ end.
+
+start_disk_log() ->
+ case application:get_env(kernel, start_disk_log) of
+ {ok, true} ->
+ [{disk_log_server,
+ {disk_log_server, start_link, []},
+ permanent, 2000, worker, [disk_log_server]},
+ {disk_log_sup, {disk_log_sup, start_link, []}, permanent,
+ 1000, supervisor, [disk_log_sup]}];
+ _ ->
+ []
+ end.
+
+start_pg2() ->
+ case application:get_env(kernel, start_pg2) of
+ {ok, true} ->
+ [{pg2, {pg2, start_link, []}, permanent, 1000, worker, [pg2]}];
+ _ ->
+ []
+ end.
+
+start_timer() ->
+ case application:get_env(kernel, start_timer) of
+ {ok, true} ->
+ [{timer_server, {timer, start_link, []}, permanent, 1000, worker,
+ [timer]}];
+ _ ->
+ []
+ end.
+
+
+
+
+
+%%-----------------------------------------------------------------
+%% The change of the distributed parameter is taken care of here
+%%-----------------------------------------------------------------
+do_distribution_change(Changed, New, Removed) ->
+ %% check if the distributed parameter is changed. It is not allowed
+ %% to make a local application to a distributed one, or vice versa.
+ case is_dist_changed(Changed, New, Removed) of
+ %%{changed, new, removed}
+ {false, false, false} ->
+ ok;
+ {C, false, false} ->
+ %% At last, update the parameter.
+ gen_server:call(dist_ac, {distribution_changed, C}, infinity);
+ {false, _, false} ->
+ error_logger:error_report("Distribution not changed: "
+ "Not allowed to add the 'distributed' "
+ "parameter."),
+ {error, {distribution_not_changed, "Not allowed to add the "
+ "'distributed' parameter"}};
+ {false, false, _} ->
+ error_logger:error_report("Distribution not changed: "
+ "Not allowed to remove the "
+ "distribution parameter."),
+ {error, {distribution_not_changed, "Not allowed to remove the "
+ "'distributed' parameter"}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Check if distribution is changed in someway.
+%%-----------------------------------------------------------------
+is_dist_changed(Changed, New, Removed) ->
+ C = case lists:keysearch(distributed, 1, Changed) of
+ false ->
+ false;
+ {value, {distributed, NewDistC}} ->
+ NewDistC
+ end,
+ N = case lists:keysearch(distributed, 1, New) of
+ false ->
+ false;
+ {value, {distributed, NewDistN}} ->
+ NewDistN
+ end,
+ R = lists:member(distributed, Removed),
+ {C, N, R}.
+
+
+
+%%-----------------------------------------------------------------
+%% The change of the global_groups parameter is taken care of here
+%%-----------------------------------------------------------------
+do_global_groups_change(Changed, New, Removed) ->
+ %% check if the global_groups parameter is changed.
+
+ case is_gg_changed(Changed, New, Removed) of
+ %%{changed, new, removed}
+ {false, false, false} ->
+ ok;
+ {C, false, false} ->
+ %% At last, update the parameter.
+ global_group:global_groups_changed(C);
+ {false, N, false} ->
+ global_group:global_groups_added(N);
+ {false, false, R} ->
+ global_group:global_groups_removed(R)
+ end.
+
+%%-----------------------------------------------------------------
+%% Check if global_groups is changed in someway.
+%%-----------------------------------------------------------------
+is_gg_changed(Changed, New, Removed) ->
+ C = case lists:keysearch(global_groups, 1, Changed) of
+ false ->
+ false;
+ {value, {global_groups, NewDistC}} ->
+ NewDistC
+ end,
+ N = case lists:keysearch(global_groups, 1, New) of
+ false ->
+ false;
+ {value, {global_groups, NewDistN}} ->
+ NewDistN
+ end,
+ R = lists:member(global_groups, Removed),
+ {C, N, R}.
+
+
+
diff --git a/patches/stdlib/gen.erl b/patches/stdlib/gen.erl
new file mode 100644
index 0000000..85b86f6
--- /dev/null
+++ b/patches/stdlib/gen.erl
@@ -0,0 +1,366 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-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([reg_behaviour/1]).
+-export([init_it/6, init_it/7]).
+
+-define(default_timeout, 5000).
+
+%%-----------------------------------------------------------------
+%% Starts a generic process.
+%% start(GenMod, LinkP, Mod, Args, Options)
+%% start(GenMod, LinkP, Name, Mod, Args, Options)
+%% start_link(Mod, Args, Options)
+%% start_link(Name, Mod, Args, Options) where:
+%% Name = {local, atom()} | {global, atom()}
+%% Mod = atom(), callback module implementing the 'real' fsm
+%% Args = term(), init arguments (to Mod:init/1)
+%% Options = [{debug, [Flag]}]
+%% Flag = trace | log | {logfile, File} | statistics | debug
+%% (debug == log && statistics)
+%% Returns: {ok, Pid} |
+%% {error, {already_started, Pid}} |
+%% {error, Reason}
+%%-----------------------------------------------------------------
+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.
+
+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 our selves "self"!!!
+%%-----------------------------------------------------------------
+do_spawn(GenMod, link, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start_link(gen, init_it,
+ [GenMod, self(), self(), Mod, Args, Options],
+ Time,
+ spawn_opts(Options));
+do_spawn(GenMod, _, Mod, Args, Options) ->
+ Time = timeout(Options),
+ proc_lib:start(gen, 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(gen, 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(gen, init_it,
+ [GenMod, self(), self, Name, Mod, Args, Options],
+ Time,
+ spawn_opts(Options)).
+
+
+reg_behaviour(B) ->
+ catch begin
+ Key = {p,l,behaviour},
+ try gproc:reg(Key, B)
+ catch
+ error:badarg ->
+ gproc:set_value(Key, B)
+ end
+ end.
+
+
+%%-----------------------------------------------------------------
+%% 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(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),
+ case catch do_call(Pid, Label, Request, Timeout) of
+ {'EXIT', {nodedown, Node}} ->
+ % A nodedown not yet detected by global, pretend that it
+ % was.
+ exit(noproc);
+ {'EXIT', noproc} ->
+ exit(noproc);
+ {'EXIT', OtherExits} ->
+ exit(OtherExits);
+ Result ->
+ Result
+ 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} ->
+ N;
+ _ when is_pid(Process) ->
+ node(Process);
+ _ ->
+ node()
+ end,
+ case catch erlang:monitor(process, Process) of
+ Mref when is_reference(Mref) ->
+ receive
+ {'DOWN', Mref, _, Pid1, noconnection} when is_pid(Pid1) ->
+ exit({nodedown, node(Pid1)});
+ {'DOWN', Mref, _, _, noconnection} ->
+ exit({nodedown, Node});
+ {'DOWN', Mref, _, _, _} ->
+ exit(noproc)
+ after 0 ->
+ Process ! {Label, {self(), Mref}, Request},
+ wait_resp_mon(Process, Mref, Timeout)
+ end;
+ {'EXIT', _} ->
+ %% Old node 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 old remote nodes.
+ monitor_node(Node, true),
+ receive
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ exit({nodedown, Node})
+ after 0 ->
+ Mref = make_ref(),
+ Process ! {Label, {self(),Mref}, Request},
+ Res = wait_resp(Node, Mref, Timeout),
+ monitor_node(Node, false),
+ Res
+ end
+ end.
+
+wait_resp_mon(Process, Mref, Timeout) ->
+ Node = case Process of
+ {_S, N} ->
+ N;
+ _ when is_pid(Process) ->
+ node(Process);
+ _ ->
+ node()
+ end,
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref),
+ receive
+ {'DOWN', Mref, _, _, _} ->
+ {ok, Reply}
+ after 0 ->
+ {ok, Reply}
+ end;
+ {'DOWN', Mref, _, Pid, Reason} when is_pid(Pid) ->
+ receive
+ {'EXIT', Pid, noconnection} ->
+ exit({nodedown, Node});
+ {'EXIT', Pid, What} ->
+ exit(What)
+ after 1 -> % Give 'EXIT' message time to arrive
+ case Reason of
+ noconnection ->
+ exit({nodedown, Node});
+ _ ->
+ exit(Reason)
+ end
+ end;
+ {'DOWN', Mref, _, _, noconnection} ->
+ %% Here is a hole, when the monitor is remote by name
+ %% and the remote node goes down, we will never find
+ %% out the Pid and cannot know which 'EXIT' message
+ %% to read out. This awkward case should have been
+ %% handled earlier (except for against rex)
+ %% by not using remote monitor by name.
+ case Process of
+ _ when is_pid(Process) ->
+ receive
+ {'EXIT', Process, noconnection} ->
+ exit({nodedown, Node});
+ {'EXIT', Process, What} ->
+ exit(What)
+ after 1 -> % Give 'EXIT' message time to arrive
+ exit({nodedown, node(Process)})
+ end;
+ _ ->
+ exit({nodedown, Node})
+ end;
+ %% {'DOWN', Mref, _, _, noproc} ->
+ %% exit(noproc);
+ {'DOWN', Mref, _Tag, _Item, Reason} ->
+ exit(Reason)
+ after Timeout ->
+ erlang:demonitor(Mref),
+ receive
+ {'DOWN', Mref, _, _, _Reason} -> true
+ after 0 -> true
+ end,
+ exit(timeout)
+ end.
+
+wait_resp(Node, Tag, Timeout) ->
+ receive
+ {Tag, Reply} ->
+ {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) ->
+ catch To ! {Tag, Reply}.
+
+%%%-----------------------------------------------------------------
+%%% Misc. functions.
+%%%-----------------------------------------------------------------
+where({global, Name}) -> global:safe_whereis_name(Name);
+where({local, Name}) -> whereis(Name).
+
+name({global, Name}) -> Name;
+name({local, Name}) -> Name.
+
+name_register({local, Name}) ->
+ case catch register(Name, self()) of
+ true -> true;
+ {'EXIT', _} ->
+ {false, where({local, Name})}
+ end;
+name_register({global, Name}) ->
+ case global:register_name(Name, self()) of
+ yes -> true;
+ no -> {false, where({global, Name})}
+ 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.
diff --git a/patches/stdlib/gen_event.erl b/patches/stdlib/gen_event.erl
new file mode 100644
index 0000000..51d0409
--- /dev/null
+++ b/patches/stdlib/gen_event.erl
@@ -0,0 +1,659 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(gen_event).
+
+%%%
+%%% A general event handler.
+%%% Several handlers (functions) can be added.
+%%% Each handler holds a state and will be called
+%%% for every event received of the handler.
+%%%
+
+%%% Modified by Magnus.
+%%% Take care of fault situations and made notify asynchronous.
+%%% Re-written by Joe with new functional interface !
+%%% Modified by Martin - uses proc_lib, sys and gen!
+
+
+-export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2,
+ sync_notify/2,
+ add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3,
+ swap_sup_handler/3, which_handlers/1, call/3, call/4]).
+
+-export([behaviour_info/1]).
+
+-export([init_it/6,
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4,
+ print_event/3,
+ format_status/2]).
+
+-import(error_logger, [error_msg/2]).
+
+-define(reply(X), From ! {element(2,Tag), X}).
+
+-record(handler, {module,
+ id = false,
+ state,
+ supervised = false}).
+
+behaviour_info(callbacks) ->
+ [{init,1},{handle_event,2},{handle_call,2},{handle_info,2},
+ {terminate,2},{code_change,3}];
+behaviour_info(_Other) ->
+ undefined.
+
+%% gen_event:start(Handler) -> ok | {error, What}
+%% gen_event:add_handler(Handler, Mod, Args) -> ok | Other
+%% gen_event:notify(Handler, Event) -> ok
+%% gen_event:call(Handler, Mod, Query) -> {ok, Val} | {error, Why}
+%% gen_event:call(Handler, Mod, Query, Timeout) -> {ok, Val} | {error, Why}
+%% gen_event:delete_handler(Handler, Mod, Args) -> Val
+%% gen_event:swap_handler(Handler, {OldMod, Args1}, {NewMod, Args2}) -> ok
+%% gen_event:which_handler(Handler) -> [Mod]
+%% gen_event:stop(Handler) -> ok
+
+
+%% handlers must export
+%% Mod:init(Args) -> {ok, State} | Other
+%% Mod:handle_event(Event, State) ->
+%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2}
+%% Mod:handle_info(Info, State) ->
+%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2}
+%% Mod:handle_call(Query, State) ->
+%% {ok, Reply, State'} | {remove_handler, Reply} |
+%% {swap_handler, Reply, Args1,State1,Mod2,Args2}
+%% Mod:terminate(Args, State) -> Val
+
+
+%% add_handler(H, Mod, Args) -> ok | Other
+%% Mod:init(Args) -> {ok, State} | Other
+
+%% delete_handler(H, Mod, Args) -> Val
+%% Mod:terminate(Args, State) -> Val
+
+%% notify(H, Event)
+%% Mod:handle_event(Event, State) ->
+%% {ok, State1}
+%% remove_handler
+%% Mod:terminate(remove_handler, State) is called
+%% the return value is ignored
+%% {swap_handler, Args1, State1, Mod2, Args2}
+%% State2 = Mod:terminate(Args1, State1) is called
+%% the return value is chained into the new module and
+%% Mod2:init({Args2, State2}) is called
+%% Other
+%% Mod:terminate({error, Other}, State) is called
+%% The return value is ignored
+%% call(H, Mod, Query) -> Val
+%% call(H, Mod, Query, Timeout) -> Val
+%% Mod:handle_call(Query, State) -> as above
+
+
+start() ->
+ gen:start(gen_event, nolink, [], [], []).
+
+start(Name) ->
+ gen:start(gen_event, nolink, Name, [], [], []).
+
+start_link() ->
+ gen:start(gen_event, link, [], [], []).
+
+start_link(Name) ->
+ gen:start(gen_event, link, Name, [], [], []).
+
+init_it(Starter, self, Name, Mod, Args, Options) ->
+ init_it(Starter, self(), Name, Mod, Args, Options);
+init_it(Starter, Parent, Name, _, _, Options) ->
+ process_flag(trap_exit, true),
+ gen:reg_behaviour(?MODULE),
+ Debug = gen:debug_options(Options),
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(Parent, Name, [], Debug).
+
+add_handler(M, Handler, Args) -> rpc (M, {add_handler, Handler, Args}).
+add_sup_handler(M, Handler, Args) ->
+ rpc (M, {add_sup_handler, Handler, Args, self()}).
+notify(M, Event) -> send(M, {notify, Event}).
+sync_notify(M, Event) -> rpc (M, {sync_notify, Event}).
+call(M, Handler, Query) -> call1(M, Handler, Query).
+call(M, Handler, Query, Timeout) -> call1(M, Handler, Query, Timeout).
+delete_handler(M, Handler, Args) -> rpc (M, {delete_handler, Handler, Args}).
+swap_handler(M, {H1, A1},{H2, A2}) -> rpc (M, {swap_handler, H1, A1, H2, A2}).
+swap_sup_handler(M, {H1, A1},{H2, A2}) ->
+ rpc (M, {swap_sup_handler, H1, A1, H2, A2, self()}).
+which_handlers(M) -> rpc (M, which_handlers).
+stop(M) -> rpc (M, stop).
+
+rpc(M, Cmd) ->
+ {ok,Reply} = gen:call(M, self(), Cmd, infinity),
+ Reply.
+
+call1(M, Handler, Query) ->
+ Cmd = {call, Handler, Query},
+ case catch gen:call(M, self(), Cmd) of
+ {ok,Res} ->
+ Res;
+ {'EXIT', Reason} ->
+ exit({Reason, {gen_event, call, [M, Handler, Query]}})
+ end.
+
+call1(M, Handler, Query, Timeout) ->
+ Cmd = {call, Handler, Query},
+ case catch gen:call(M, self(), Cmd, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT', Reason} ->
+ exit({Reason, {gen_event, call, [M, Handler, Query, Timeout]}})
+ end.
+
+send({global, Name}, Cmd) ->
+ catch global:send(Name, Cmd),
+ ok;
+send(M, Cmd) ->
+ M ! Cmd,
+ ok.
+
+loop(Parent, ServerName, MSL, Debug) ->
+ receive
+ {system, From, Req} ->
+ sys:handle_system_msg(Req, From, Parent, gen_event, Debug,
+ [ServerName, MSL]);
+ {'EXIT', Parent, Reason} ->
+ terminate_server(Reason, Parent, MSL, ServerName);
+ Msg when Debug =:= [] ->
+ handle_msg(Msg, Parent, ServerName, MSL, []);
+ Msg ->
+ Debug1 = sys:handle_debug(Debug, {gen_event, print_event},
+ ServerName, {in, Msg}),
+ handle_msg(Msg, Parent, ServerName, MSL, Debug1)
+ end.
+
+handle_msg(Msg, Parent, ServerName, MSL, Debug) ->
+ case Msg of
+ {notify, Event} ->
+ MSL1 = server_notify(Event, handle_event, MSL, ServerName),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {sync_notify, Event}} ->
+ MSL1 = server_notify(Event, handle_event, MSL, ServerName),
+ ?reply(ok),
+ loop(Parent, ServerName, MSL1, Debug);
+ {'EXIT', From, Reason} ->
+ MSL1 = handle_exit(From, Reason, MSL, ServerName),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {call, Handler, Query}} ->
+ {Reply, MSL1} = server_call(Handler, Query, MSL, ServerName),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {add_handler, Handler, Args}} ->
+ {Reply, MSL1} = server_add_handler(Handler, Args, MSL),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {add_sup_handler, Handler, Args, SupP}} ->
+ {Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {delete_handler, Handler, Args}} ->
+ {Reply, MSL1} = server_delete_handler(Handler, Args, MSL,
+ ServerName),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} ->
+ {Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2,
+ Args2, MSL, ServerName),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2,
+ Sup}} ->
+ {Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2,
+ Args2, MSL, Sup, ServerName),
+ ?reply(Reply),
+ loop(Parent, ServerName, MSL1, Debug);
+ {From, Tag, stop} ->
+ catch terminate_server(normal, Parent, MSL, ServerName),
+ ?reply(ok);
+ {From, Tag, which_handlers} ->
+ ?reply(the_handlers(MSL)),
+ loop(Parent, ServerName, MSL, Debug);
+ {From, Tag, get_modules} ->
+ ?reply(get_modules(MSL)),
+ loop(Parent, ServerName, MSL, Debug);
+ Other ->
+ MSL1 = server_notify(Other, handle_info, MSL, ServerName),
+ loop(Parent, ServerName, MSL1, Debug)
+ end.
+
+terminate_server(Reason, Parent, MSL, ServerName) ->
+ stop_handlers(MSL, ServerName),
+ do_unlink(Parent, MSL),
+ exit(Reason).
+
+%% unlink the supervisor process of all supervised handlers.
+%% We do not want a handler supervisor to EXIT due to the
+%% termination of the event manager (server).
+%% Do not unlink Parent !
+do_unlink(Parent, MSL) ->
+ lists:foreach(fun(Handler) when Handler#handler.supervised =:= Parent ->
+ true;
+ (Handler) when is_pid(Handler#handler.supervised) ->
+ unlink(Handler#handler.supervised),
+ true;
+ (_) ->
+ true
+ end,
+ MSL).
+
+%% First terminate the supervised (if exists) handlers and
+%% then inform other handlers.
+%% We do not know if any handler really is interested but it
+%% may be so !
+handle_exit(From, Reason, MSL, SName) ->
+ MSL1 = terminate_supervised(From, Reason, MSL, SName),
+ server_notify({'EXIT', From, Reason}, handle_info, MSL1, SName).
+
+terminate_supervised(Pid, Reason, MSL, SName) ->
+ F = fun(Ha) when Ha#handler.supervised =:= Pid ->
+ do_terminate(Ha#handler.module,
+ Ha,
+ {stop,Reason},
+ Ha#handler.state,
+ {parent_terminated, {Pid,Reason}},
+ SName,
+ shutdown),
+ false;
+ (_) ->
+ true
+ end,
+ lists:filter(F, MSL).
+
+%%-----------------------------------------------------------------
+%% Callback functions for system messages handling.
+%%-----------------------------------------------------------------
+system_continue(Parent, Debug, [ServerName, MSL]) ->
+ loop(Parent, ServerName, MSL, Debug).
+
+system_terminate(Reason, Parent, _Debug, [ServerName, MSL]) ->
+ terminate_server(Reason, Parent, MSL, ServerName).
+
+%%-----------------------------------------------------------------
+%% Module here is sent in the system msg change_code. It specifies
+%% which module should be changed.
+%%-----------------------------------------------------------------
+system_code_change([ServerName, MSL], Module, OldVsn, Extra) ->
+ MSL1 = lists:zf(fun(H) when H#handler.module =:= Module ->
+ {ok, NewState} =
+ Module:code_change(OldVsn,
+ H#handler.state, Extra),
+ {true, H#handler{state = NewState}};
+ (_) -> true
+ end,
+ MSL),
+ {ok, [ServerName, MSL1]}.
+
+%%-----------------------------------------------------------------
+%% Format debug messages. Print them as the call-back module sees
+%% them, not as the real erlang messages. Use trace for that.
+%%-----------------------------------------------------------------
+print_event(Dev, {in, Msg}, Name) ->
+ case Msg of
+ {notify, Event} ->
+ io:format(Dev, "*DBG* ~p got event ~p~n", [Name, Event]);
+ {_,_,{call, Handler, Query}} ->
+ io:format(Dev, "*DBG* ~p(~p) got call ~p~n",
+ [Name, Handler, Query]);
+ _ ->
+ io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
+ end;
+print_event(Dev, Dbg, Name) ->
+ io:format(Dev, "*DBG* ~p : ~p~n", [Name, Dbg]).
+
+
+%% server_add_handler(Handler, Args, MSL) -> {Ret, MSL'}.
+%% where MSL = [#handler]
+%% Ret goes to the top level MSL' is the new internal state of the
+%% event handler
+
+server_add_handler({Mod,Id}, Args, MSL) ->
+ Handler = #handler{module = Mod,
+ id = Id},
+ server_add_handler(Mod, Handler, Args, MSL);
+server_add_handler(Mod, Args, MSL) ->
+ Handler = #handler{module = Mod},
+ server_add_handler(Mod, Handler, Args, MSL).
+
+server_add_handler(Mod, Handler, Args, MSL) ->
+ case catch Mod:init(Args) of
+ {ok, State} ->
+ {ok, [Handler#handler{state = State}|MSL]};
+ Other ->
+ {Other, MSL}
+ end.
+
+%% Set up a link to the supervising process.
+%% (Ought to be unidirected links here, Erl5.0 !!)
+%% NOTE: This link will not be removed then the
+%% handler is removed in case another handler has
+%% own link to this process.
+server_add_sup_handler({Mod,Id}, Args, MSL, Parent) ->
+ link(Parent),
+ Handler = #handler{module = Mod,
+ id = Id,
+ supervised = Parent},
+ server_add_handler(Mod, Handler, Args, MSL);
+server_add_sup_handler(Mod, Args, MSL, Parent) ->
+ link(Parent),
+ Handler = #handler{module = Mod,
+ supervised = Parent},
+ server_add_handler(Mod, Handler, Args, MSL).
+
+%% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'}
+
+server_delete_handler(HandlerId, Args, MSL, SName) ->
+ case split(HandlerId, MSL) of
+ {Mod, Handler, MSL1} ->
+ {do_terminate(Mod, Handler, Args,
+ Handler#handler.state, delete, SName, normal),
+ MSL1};
+ error ->
+ {{error, module_not_found}, MSL}
+ end.
+
+%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SN)= -> MSL'
+%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SN)= -> MSL'
+
+server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SName) ->
+ {State2, Sup, MSL1} = split_and_terminate(Handler1, Args1, MSL,
+ SName, Handler2, false),
+ case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of
+ {ok, MSL2} ->
+ {ok, MSL2};
+ {What, MSL2} ->
+ {{error, What}, MSL2}
+ end.
+
+server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SName) ->
+ {State2, _, MSL1} = split_and_terminate(Handler1, Args1, MSL,
+ SName, Handler2, Sup),
+ case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of
+ {ok, MSL2} ->
+ {ok, MSL2};
+ {What, MSL2} ->
+ {{error, What}, MSL2}
+ end.
+
+s_s_h(false, Handler, Args, MSL) ->
+ server_add_handler(Handler, Args, MSL);
+s_s_h(Pid, Handler, Args, MSL) ->
+ server_add_sup_handler(Handler, Args, MSL, Pid).
+
+split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) ->
+ case split(HandlerId, MSL) of
+ {Mod, Handler, MSL1} ->
+ OldSup = Handler#handler.supervised,
+ NewSup = if
+ not Sup -> OldSup;
+ true -> Sup
+ end,
+ {do_terminate(Mod, Handler, Args,
+ Handler#handler.state, swapped, SName,
+ {swapped, Handler2, NewSup}),
+ OldSup,
+ MSL1};
+ error ->
+ {error, false, MSL}
+ end.
+
+%% server_notify(Event, Func, MSL, SName) -> MSL'
+
+server_notify(Event, Func, [Handler|T], SName) ->
+ case server_update(Handler, Func, Event, SName) of
+ {ok, Handler1} ->
+ [Handler1|server_notify(Event, Func, T, SName)];
+ no ->
+ server_notify(Event, Func, T, SName)
+ end;
+server_notify(_, _, [], _) ->
+ [].
+
+%% server_update(Handler, Func, Event, ServerName) -> Handler1 | no
+
+server_update(Handler1, Func, Event, SName) ->
+ Mod1 = Handler1#handler.module,
+ State = Handler1#handler.state,
+ case catch Mod1:Func(Event, State) of
+ {ok, State1} ->
+ {ok, Handler1#handler{state = State1}};
+ {swap_handler, Args1, State1, Handler2, Args2} ->
+ do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName);
+ remove_handler ->
+ do_terminate(Mod1, Handler1, remove_handler, State,
+ remove, SName, normal),
+ no;
+ Other ->
+ do_terminate(Mod1, Handler1, {error, Other}, State,
+ Event, SName, crash),
+ no
+ end.
+
+do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName) ->
+ %% finalise the existing handler
+ State2 = do_terminate(Mod1, Handler1, Args1, State1,
+ swapped, SName,
+ {swapped, Handler2, Handler1#handler.supervised}),
+ {Mod2,Handler} = new_handler(Handler2, Handler1),
+ case catch Mod2:init({Args2, State2}) of
+ {ok, State2a} ->
+ {ok, Handler#handler{state = State2a}};
+ Other ->
+ report_terminate(Handler2, crash, {error, Other}, SName, false),
+ no
+ end.
+
+new_handler({Mod,Id}, Handler1) ->
+ {Mod,#handler{module = Mod,
+ id = Id,
+ supervised = Handler1#handler.supervised}};
+new_handler(Mod, Handler1) ->
+ {Mod,#handler{module = Mod,
+ supervised = Handler1#handler.supervised}}.
+
+
+%% split(Handler, [#handler]) ->
+%% {Mod, #handler, [#handler]} | error
+
+split(Ha, MSL) -> split(Ha, MSL, []).
+
+split({Mod,Id}, [Ha|T], L) when Ha#handler.module =:= Mod,
+ Ha#handler.id =:= Id ->
+ {Mod, Ha, lists:reverse(L, T)};
+split(Mod, [Ha|T], L) when Ha#handler.module =:= Mod,
+ not Ha#handler.id ->
+ {Mod, Ha, lists:reverse(L, T)};
+split(Ha, [H|T], L) ->
+ split(Ha, T, [H|L]);
+split(_, [], _) ->
+ error.
+
+%% server_call(Handler, Query, MSL, ServerName) ->
+%% {Reply, MSL1}
+
+server_call(Handler, Query, MSL, SName) ->
+ case search(Handler, MSL) of
+ {ok, Ha} ->
+ case server_call_update(Ha, Query, SName) of
+ {no, Reply} ->
+ {Reply, delete(Handler, MSL)};
+ {{ok, Ha1}, Reply} ->
+ {Reply, replace(Handler, MSL, Ha1)}
+ end;
+ false ->
+ {{error, bad_module}, MSL}
+ end.
+
+search({Mod, Id}, [Ha|_MSL]) when Ha#handler.module =:= Mod,
+ Ha#handler.id =:= Id ->
+ {ok, Ha};
+search(Mod, [Ha|_MSL]) when Ha#handler.module =:= Mod,
+ not Ha#handler.id ->
+ {ok, Ha};
+search(Handler, [_|MSL]) ->
+ search(Handler, MSL);
+search(_, []) ->
+ false.
+
+delete({Mod, Id}, [Ha|MSL]) when Ha#handler.module =:= Mod,
+ Ha#handler.id =:= Id ->
+ MSL;
+delete(Mod, [Ha|MSL]) when Ha#handler.module =:= Mod,
+ not Ha#handler.id ->
+ MSL;
+delete(Handler, [Ha|MSL]) ->
+ [Ha|delete(Handler, MSL)];
+delete(_, []) ->
+ [].
+
+replace({Mod, Id}, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod,
+ Ha#handler.id =:= Id ->
+ [NewHa|MSL];
+replace(Mod, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod,
+ not Ha#handler.id ->
+ [NewHa|MSL];
+replace(Handler, [Ha|MSL], NewHa) ->
+ [Ha|replace(Handler, MSL, NewHa)];
+replace(_, [], NewHa) ->
+ [NewHa].
+
+%% server_call_update(Handler, Query, ServerName) ->
+%% {{Handler1, State1} | no, Reply}
+
+server_call_update(Handler1, Query, SName) ->
+ Mod1 = Handler1#handler.module,
+ State = Handler1#handler.state,
+ case catch Mod1:handle_call(Query, State) of
+ {ok, Reply, State1} ->
+ {{ok, Handler1#handler{state = State1}}, Reply};
+ {swap_handler, Reply, Args1, State1, Handler2, Args2} ->
+ {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply};
+ {remove_handler, Reply} ->
+ do_terminate(Mod1, Handler1, remove_handler, State,
+ remove, SName, normal),
+ {no, Reply};
+ Other ->
+ do_terminate(Mod1, Handler1, {error, Other}, State,
+ Query, SName, crash),
+ {no, {error, Other}}
+end.
+
+do_terminate(Mod, Handler, Args, State, LastIn, SName, Reason) ->
+ Res = (catch Mod:terminate(Args, State)),
+ report_terminate(Handler, Reason, Args, State, LastIn, SName, Res),
+ Res.
+
+report_terminate(Handler, crash, {error, Why}, State, LastIn, SName, _) ->
+ report_terminate(Handler, Why, State, LastIn, SName);
+report_terminate(Handler, How, _, State, LastIn, SName, _) ->
+ %% How == normal | shutdown | {swapped, NewHandler, NewSupervisor}
+ report_terminate(Handler, How, State, LastIn, SName).
+
+report_terminate(Handler, Reason, State, LastIn, SName) ->
+ report_error(Handler, Reason, State, LastIn, SName),
+ case Handler#handler.supervised of
+ false ->
+ ok;
+ Pid ->
+ Pid ! {gen_event_EXIT,handler(Handler),Reason},
+ ok
+ end.
+
+report_error(_Handler, normal, _, _, _) -> ok;
+report_error(_Handler, shutdown, _, _, _) -> ok;
+report_error(_Handler, {swapped,_,_}, _, _, _) -> ok;
+report_error(Handler, Reason, State, LastIn, SName) ->
+ Reason1 =
+ case Reason of
+ {'EXIT',{undef,[{M,F,A}|MFAs]}} ->
+ case code:is_loaded(M) of
+ false ->
+ {'module could not be loaded',[{M,F,A}|MFAs]};
+ _ ->
+ case erlang:function_exported(M, F, length(A)) of
+ true ->
+ {undef,[{M,F,A}|MFAs]};
+ false ->
+ {'function not exported',[{M,F,A}|MFAs]}
+ end
+ end;
+ {'EXIT',Why} ->
+ Why;
+ _ ->
+ Reason
+ end,
+ error_msg("** gen_event handler ~p crashed.~n"
+ "** Was installed in ~p~n"
+ "** Last event was: ~p~n"
+ "** When handler state == ~p~n"
+ "** Reason == ~p~n",
+ [handler(Handler),SName,LastIn,State,Reason1]).
+
+handler(Handler) when not Handler#handler.id ->
+ Handler#handler.module;
+handler(Handler) ->
+ {Handler#handler.module, Handler#handler.id}.
+
+%% stop_handlers(MSL, ServerName) -> []
+
+stop_handlers([Handler|T], SName) ->
+ Mod = Handler#handler.module,
+ do_terminate(Mod, Handler, stop, Handler#handler.state,
+ stop, SName, shutdown),
+ stop_handlers(T, SName);
+stop_handlers([], _) ->
+ [].
+
+the_handlers(MSL) ->
+ lists:map(fun(Handler) when not Handler#handler.id ->
+ Handler#handler.module;
+ (Handler) ->
+ {Handler#handler.module, Handler#handler.id}
+ end,
+ MSL).
+
+%% Message from the release_handler.
+%% The list of modules got to be a set !
+get_modules(MSL) ->
+ Mods = lists:map(fun(Handler) -> Handler#handler.module end,
+ MSL),
+ ordsets:to_list(ordsets:from_list(Mods)).
+
+%%-----------------------------------------------------------------
+%% Status information
+%%-----------------------------------------------------------------
+format_status(_Opt, StatusData) ->
+ [_PDict, SysState, Parent, _Debug, [ServerName, MSL]] = StatusData,
+ Header = lists:concat(["Status for event handler ", ServerName]),
+ [{header, Header},
+ {data, [{"Status", SysState},
+ {"Parent", Parent}]},
+ {items, {"Installed handlers", MSL}}].
+
+
+
+
+
+
diff --git a/patches/stdlib/gen_fsm.erl b/patches/stdlib/gen_fsm.erl
new file mode 100644
index 0000000..899dc2c
--- /dev/null
+++ b/patches/stdlib/gen_fsm.erl
@@ -0,0 +1,596 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(gen_fsm).
+
+%%%-----------------------------------------------------------------
+%%%
+%%% This state machine is somewhat more pure than state_lib. It is
+%%% still based on State dispatching (one function per state), but
+%%% allows a function handle_event to take care of events in all states.
+%%% It's not that pure anymore :( We also allow synchronized event sending.
+%%%
+%%% If the Parent process terminates the Module:terminate/2
+%%% function is called.
+%%%
+%%% The user module should export:
+%%%
+%%% init(Args)
+%%% ==> {ok, StateName, StateData}
+%%% {ok, StateName, StateData, Timeout}
+%%% ignore
+%%% {stop, Reason}
+%%%
+%%% StateName(Msg, StateData)
+%%%
+%%% ==> {next_state, NewStateName, NewStateData}
+%%% {next_state, NewStateName, NewStateData, Timeout}
+%%% {stop, Reason, NewStateData}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% StateName(Msg, From, StateData)
+%%%
+%%% ==> {next_state, NewStateName, NewStateData}
+%%% {next_state, NewStateName, NewStateData, Timeout}
+%%% {reply, Reply, NewStateName, NewStateData}
+%%% {reply, Reply, NewStateName, NewStateData, Timeout}
+%%% {stop, Reason, NewStateData}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_event(Msg, StateName, StateData)
+%%%
+%%% ==> {next_state, NewStateName, NewStateData}
+%%% {next_state, NewStateName, NewStateData, Timeout}
+%%% {stop, Reason, Reply, NewStateData}
+%%% {stop, Reason, NewStateData}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_sync_event(Msg, From, StateName, StateData)
+%%%
+%%% ==> {next_state, NewStateName, NewStateData}
+%%% {next_state, NewStateName, NewStateData, Timeout}
+%%% {reply, Reply, NewStateName, NewStateData}
+%%% {reply, Reply, NewStateName, NewStateData, Timeout}
+%%% {stop, Reason, Reply, NewStateData}
+%%% {stop, Reason, NewStateData}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_info(Info, StateName) (e.g. {'EXIT', P, R}, {nodedown, N}, ...
+%%%
+%%% ==> {next_state, NewStateName, NewStateData}
+%%% {next_state, NewStateName, NewStateData, Timeout}
+%%% {stop, Reason, NewStateData}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% terminate(Reason, StateName, StateData) Let the user module clean up
+%%% always called when server terminates
+%%%
+%%% ==> the return value is ignored
+%%%
+%%%
+%%% The work flow (of the fsm) can be described as follows:
+%%%
+%%% User module fsm
+%%% ----------- -------
+%%% start -----> start
+%%% init <----- .
+%%%
+%%% loop
+%%% StateName <----- .
+%%%
+%%% handle_event <----- .
+%%%
+%%% handle__sunc_event <----- .
+%%%
+%%% handle_info <----- .
+%%%
+%%% terminate <----- .
+%%%
+%%%
+%%% ---------------------------------------------------
+
+-export([start/3, start/4,
+ start_link/3, start_link/4,
+ send_event/2, sync_send_event/2, sync_send_event/3,
+ send_all_state_event/2,
+ sync_send_all_state_event/2, sync_send_all_state_event/3,
+ reply/2,
+ start_timer/2,send_event_after/2,cancel_timer/1,
+ enter_loop/4, enter_loop/5, enter_loop/6]).
+
+-export([behaviour_info/1]).
+
+%% Internal exports
+-export([init_it/6, print_event/3,
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4,
+ format_status/2]).
+
+-import(error_logger , [format/2]).
+
+%%% ---------------------------------------------------
+%%% Interface functions.
+%%% ---------------------------------------------------
+
+behaviour_info(callbacks) ->
+ [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3},
+ {terminate,3},{code_change,4}];
+behaviour_info(_Other) ->
+ undefined.
+
+%%% ---------------------------------------------------
+%%% Starts a generic state machine.
+%%% start(Mod, Args, Options)
+%%% start(Name, Mod, Args, Options)
+%%% start_link(Mod, Args, Options)
+%%% start_link(Name, Mod, Args, Options) where:
+%%% Name ::= {local, atom()} | {global, atom()}
+%%% Mod ::= atom(), callback module implementing the 'real' fsm
+%%% Args ::= term(), init arguments (to Mod:init/1)
+%%% Options ::= [{debug, [Flag]}]
+%%% Flag ::= trace | log | {logfile, File} | statistics | debug
+%%% (debug == log && statistics)
+%%% Returns: {ok, Pid} |
+%%% {error, {already_started, Pid}} |
+%%% {error, Reason}
+%%% ---------------------------------------------------
+start(Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Mod, Args, Options).
+
+start(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Name, Mod, Args, Options).
+
+start_link(Mod, Args, Options) ->
+ gen:start(?MODULE, link, Mod, Args, Options).
+
+start_link(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, link, Name, Mod, Args, Options).
+
+
+send_event({global, Name}, Event) ->
+ catch global:send(Name, {'$gen_event', Event}),
+ ok;
+send_event(Name, Event) ->
+ Name ! {'$gen_event', Event},
+ ok.
+
+sync_send_event(Name, Event) ->
+ case catch gen:call(Name, '$gen_sync_event', Event) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, sync_send_event, [Name, Event]}})
+ end.
+
+sync_send_event(Name, Event, Timeout) ->
+ case catch gen:call(Name, '$gen_sync_event', Event, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, sync_send_event, [Name, Event, Timeout]}})
+ end.
+
+send_all_state_event({global, Name}, Event) ->
+ catch global:send(Name, {'$gen_all_state_event', Event}),
+ ok;
+send_all_state_event(Name, Event) ->
+ Name ! {'$gen_all_state_event', Event},
+ ok.
+
+sync_send_all_state_event(Name, Event) ->
+ case catch gen:call(Name, '$gen_sync_all_state_event', Event) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, sync_send_all_state_event, [Name, Event]}})
+ end.
+
+sync_send_all_state_event(Name, Event, Timeout) ->
+ case catch gen:call(Name, '$gen_sync_all_state_event', Event, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, sync_send_all_state_event,
+ [Name, Event, Timeout]}})
+ end.
+
+%% Designed to be only callable within one of the callbacks
+%% hence using the self() of this instance of the process.
+%% This is to ensure that timers don't go astray in global
+%% e.g. when straddling a failover, or turn up in a restarted
+%% instance of the process.
+
+%% Returns Ref, sends event {timeout,Ref,Msg} after Time
+%% to the (then) current state.
+start_timer(Time, Msg) ->
+ erlang:start_timer(Time, self(), {'$gen_timer', Msg}).
+
+%% Returns Ref, sends Event after Time to the (then) current state.
+send_event_after(Time, Event) ->
+ erlang:start_timer(Time, self(), {'$gen_event', Event}).
+
+%% Returns the remaing time for the timer if Ref referred to
+%% an active timer/send_event_after, false otherwise.
+cancel_timer(Ref) ->
+ case erlang:cancel_timer(Ref) of
+ false ->
+ receive {timeout, Ref, _} -> 0
+ after 0 -> false
+ end;
+ RemainingTime ->
+ RemainingTime
+ end.
+
+%% enter_loop/4,5,6
+%% Makes an existing process into a gen_fsm.
+%% The calling process will enter the gen_fsm receive loop and become a
+%% gen_fsm process.
+%% The process *must* have been started using one of the start functions
+%% in proc_lib, see proc_lib(3).
+%% The user is responsible for any initialization of the process,
+%% including registering a name for it.
+enter_loop(Mod, Options, StateName, StateData) ->
+ enter_loop(Mod, Options, StateName, StateData, self(), infinity).
+
+enter_loop(Mod, Options, StateName, StateData, ServerName = {_,_}) ->
+ enter_loop(Mod, Options, StateName, StateData, ServerName,infinity);
+enter_loop(Mod, Options, StateName, StateData, Timeout) ->
+ enter_loop(Mod, Options, StateName, StateData, self(), Timeout).
+
+enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) ->
+ Name = get_proc_name(ServerName),
+ Parent = get_parent(),
+ Debug = gen:debug_options(Options),
+ loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug).
+
+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:safe_whereis_name(Name) of
+ undefined ->
+ exit(process_not_registered_globally);
+ Pid when Pid =:= self() ->
+ Name;
+ _Pid ->
+ exit(process_not_registered_globally)
+ 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:safe_whereis_name(Name) of
+ undefined ->
+ exit(could_not_find_registerd_name);
+ Pid ->
+ Pid
+ end;
+ Pid ->
+ Pid
+ end.
+
+%%% ---------------------------------------------------
+%%% 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(Starter, self, Name, Mod, Args, Options) ->
+ init_it(Starter, self(), Name, Mod, Args, Options);
+init_it(Starter, Parent, Name, Mod, Args, Options) ->
+ Debug = gen:debug_options(Options),
+ gen:reg_behaviour(?MODULE),
+ case catch Mod:init(Args) of
+ {ok, StateName, StateData} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(Parent, Name, StateName, StateData, Mod, infinity, Debug);
+ {ok, StateName, StateData, Timeout} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug);
+ {stop, Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ ignore ->
+ proc_lib:init_ack(Starter, ignore),
+ exit(normal);
+ {'EXIT', Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ Else ->
+ Error = {bad_return_value, Else},
+ proc_lib:init_ack(Starter, {error, Error}),
+ exit(Error)
+ end.
+
+%%-----------------------------------------------------------------
+%% The MAIN loop
+%%-----------------------------------------------------------------
+loop(Parent, Name, StateName, StateData, Mod, Time, Debug) ->
+ Msg = receive
+ Input ->
+ Input
+ after Time ->
+ {'$gen_event', timeout}
+ end,
+ case Msg of
+ {system, From, Req} ->
+ sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
+ [Name, StateName, StateData, Mod, Time]);
+ {'EXIT', Parent, Reason} ->
+ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug);
+ _Msg when Debug =:= [] ->
+ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time);
+ _Msg ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ {Name, StateName}, {in, Msg}),
+ handle_msg(Msg, Parent, Name, StateName, StateData,
+ Mod, Time, Debug1)
+ end.
+
+%%-----------------------------------------------------------------
+%% Callback functions for system messages handling.
+%%-----------------------------------------------------------------
+system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time]) ->
+ loop(Parent, Name, StateName, StateData, Mod, Time, Debug).
+
+system_terminate(Reason, _Parent, Debug,
+ [Name, StateName, StateData, Mod, _Time]) ->
+ terminate(Reason, Name, [], Mod, StateName, StateData, Debug).
+
+system_code_change([Name, StateName, StateData, Mod, Time],
+ _Module, OldVsn, Extra) ->
+ case catch Mod:code_change(OldVsn, StateName, StateData, Extra) of
+ {ok, NewStateName, NewStateData} ->
+ {ok, [Name, NewStateName, NewStateData, Mod, Time]};
+ Else -> Else
+ end.
+
+%%-----------------------------------------------------------------
+%% Format debug messages. Print them as the call-back module sees
+%% them, not as the real erlang messages. Use trace for that.
+%%-----------------------------------------------------------------
+print_event(Dev, {in, Msg}, {Name, StateName}) ->
+ case Msg of
+ {'$gen_event', Event} ->
+ io:format(Dev, "*DBG* ~p got event ~p in state ~w~n",
+ [Name, Event, StateName]);
+ {'$gen_all_state_event', Event} ->
+ io:format(Dev,
+ "*DBG* ~p got all_state_event ~p in state ~w~n",
+ [Name, Event, StateName]);
+ {timeout, Ref, {'$gen_timer', Message}} ->
+ io:format(Dev,
+ "*DBG* ~p got timer ~p in state ~w~n",
+ [Name, {timeout, Ref, Message}, StateName]);
+ {timeout, _Ref, {'$gen_event', Event}} ->
+ io:format(Dev,
+ "*DBG* ~p got timer ~p in state ~w~n",
+ [Name, Event, StateName]);
+ _ ->
+ io:format(Dev, "*DBG* ~p got ~p in state ~w~n",
+ [Name, Msg, StateName])
+ end;
+print_event(Dev, {out, Msg, To, StateName}, Name) ->
+ io:format(Dev, "*DBG* ~p sent ~p to ~w~n"
+ " and switched to state ~w~n",
+ [Name, Msg, To, StateName]);
+print_event(Dev, return, {Name, StateName}) ->
+ io:format(Dev, "*DBG* ~p switched to state ~w~n",
+ [Name, StateName]).
+
+handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time) -> %No debug here
+ From = from(Msg),
+ case catch dispatch(Msg, Mod, StateName, StateData) of
+ {next_state, NStateName, NStateData} ->
+ loop(Parent, Name, NStateName, NStateData, Mod, infinity, []);
+ {next_state, NStateName, NStateData, Time1} ->
+ loop(Parent, Name, NStateName, NStateData, Mod, Time1, []);
+ {reply, Reply, NStateName, NStateData} when From =/= undefined ->
+ reply(From, Reply),
+ loop(Parent, Name, NStateName, NStateData, Mod, infinity, []);
+ {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined ->
+ reply(From, Reply),
+ loop(Parent, Name, NStateName, NStateData, Mod, Time1, []);
+ {stop, Reason, NStateData} ->
+ terminate(Reason, Name, Msg, Mod, StateName, NStateData, []);
+ {stop, Reason, Reply, NStateData} when From =/= undefined ->
+ {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod,
+ StateName, NStateData, [])),
+ reply(From, Reply),
+ exit(R);
+ {'EXIT', What} ->
+ terminate(What, Name, Msg, Mod, StateName, StateData, []);
+ Reply ->
+ terminate({bad_return_value, Reply},
+ Name, Msg, Mod, StateName, StateData, [])
+ end.
+
+handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) ->
+ From = from(Msg),
+ case catch dispatch(Msg, Mod, StateName, StateData) of
+ {next_state, NStateName, NStateData} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ {Name, NStateName}, return),
+ loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1);
+ {next_state, NStateName, NStateData, Time1} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ {Name, NStateName}, return),
+ loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1);
+ {reply, Reply, NStateName, NStateData} when From =/= undefined ->
+ Debug1 = reply(Name, From, Reply, Debug, NStateName),
+ loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1);
+ {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined ->
+ Debug1 = reply(Name, From, Reply, Debug, NStateName),
+ loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1);
+ {stop, Reason, NStateData} ->
+ terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug);
+ {stop, Reason, Reply, NStateData} when From =/= undefined ->
+ {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod,
+ StateName, NStateData, Debug)),
+ reply(Name, From, Reply, Debug, StateName),
+ exit(R);
+ {'EXIT', What} ->
+ terminate(What, Name, Msg, Mod, StateName, StateData, Debug);
+ Reply ->
+ terminate({bad_return_value, Reply},
+ Name, Msg, Mod, StateName, StateData, Debug)
+ end.
+
+dispatch({'$gen_event', Event}, Mod, StateName, StateData) ->
+ Mod:StateName(Event, StateData);
+dispatch({'$gen_all_state_event', Event}, Mod, StateName, StateData) ->
+ Mod:handle_event(Event, StateName, StateData);
+dispatch({'$gen_sync_event', From, Event}, Mod, StateName, StateData) ->
+ Mod:StateName(Event, From, StateData);
+dispatch({'$gen_sync_all_state_event', From, Event},
+ Mod, StateName, StateData) ->
+ Mod:handle_sync_event(Event, From, StateName, StateData);
+dispatch({timeout, Ref, {'$gen_timer', Msg}}, Mod, StateName, StateData) ->
+ Mod:StateName({timeout, Ref, Msg}, StateData);
+dispatch({timeout, _Ref, {'$gen_event', Event}}, Mod, StateName, StateData) ->
+ Mod:StateName(Event, StateData);
+dispatch(Info, Mod, StateName, StateData) ->
+ Mod:handle_info(Info, StateName, StateData).
+
+from({'$gen_sync_event', From, _Event}) -> From;
+from({'$gen_sync_all_state_event', From, _Event}) -> From;
+from(_) -> undefined.
+
+%% Send a reply to the client.
+reply({To, Tag}, Reply) ->
+ catch To ! {Tag, Reply}.
+
+reply(Name, {To, Tag}, Reply, Debug, StateName) ->
+ reply({To, Tag}, Reply),
+ sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {out, Reply, To, StateName}).
+
+%%% ---------------------------------------------------
+%%% Terminate the server.
+%%% ---------------------------------------------------
+
+terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
+ case catch Mod:terminate(Reason, StateName, StateData) of
+ {'EXIT', R} ->
+ error_info(R, Name, Msg, StateName, StateData, Debug),
+ exit(R);
+ _ ->
+ case Reason of
+ normal ->
+ exit(normal);
+ shutdown ->
+ exit(shutdown);
+ _ ->
+ error_info(Reason, Name, Msg, StateName, StateData, Debug),
+ exit(Reason)
+ end
+ end.
+
+error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
+ Reason1 =
+ case Reason of
+ {undef,[{M,F,A}|MFAs]} ->
+ case code:is_loaded(M) of
+ false ->
+ {'module could not be loaded',[{M,F,A}|MFAs]};
+ _ ->
+ case erlang:function_exported(M, F, length(A)) of
+ true ->
+ Reason;
+ false ->
+ {'function not exported',[{M,F,A}|MFAs]}
+ end
+ end;
+ _ ->
+ Reason
+ end,
+ Str = "** State machine ~p terminating \n" ++
+ get_msg_str(Msg) ++
+ "** When State == ~p~n"
+ "** Data == ~p~n"
+ "** Reason for termination = ~n** ~p~n",
+ format(Str, [Name, get_msg(Msg), StateName, StateData, Reason1]),
+ sys:print_log(Debug),
+ ok.
+
+get_msg_str({'$gen_event', _Event}) ->
+ "** Last event in was ~p~n";
+get_msg_str({'$gen_sync_event', _Event}) ->
+ "** Last sync event in was ~p~n";
+get_msg_str({'$gen_all_state_event', _Event}) ->
+ "** Last event in was ~p (for all states)~n";
+get_msg_str({'$gen_sync_all_state_event', _Event}) ->
+ "** Last sync event in was ~p (for all states)~n";
+get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) ->
+ "** Last timer event in was ~p~n";
+get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) ->
+ "** Last timer event in was ~p~n";
+get_msg_str(_Msg) ->
+ "** Last message in was ~p~n".
+
+get_msg({'$gen_event', Event}) -> Event;
+get_msg({'$gen_sync_event', Event}) -> Event;
+get_msg({'$gen_all_state_event', Event}) -> Event;
+get_msg({'$gen_sync_all_state_event', Event}) -> Event;
+get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> {timeout, Ref, Msg};
+get_msg({timeout, _Ref, {'$gen_event', Event}}) -> Event;
+get_msg(Msg) -> Msg.
+
+%%-----------------------------------------------------------------
+%% Status information
+%%-----------------------------------------------------------------
+format_status(Opt, StatusData) ->
+ [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] =
+ StatusData,
+ Header = lists:concat(["Status for state machine ", Name]),
+ Log = sys:get_debug(log, Debug, []),
+ Specfic =
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ case catch Mod:format_status(Opt,[PDict,StateData]) of
+ {'EXIT', _} -> [{data, [{"StateData", StateData}]}];
+ Else -> Else
+ end;
+ _ ->
+ [{data, [{"StateData", StateData}]}]
+ end,
+ [{header, Header},
+ {data, [{"Status", SysState},
+ {"Parent", Parent},
+ {"Logged events", Log},
+ {"StateName", StateName}]} |
+ Specfic].
diff --git a/patches/stdlib/gen_server.erl b/patches/stdlib/gen_server.erl
new file mode 100644
index 0000000..54aca0d
--- /dev/null
+++ b/patches/stdlib/gen_server.erl
@@ -0,0 +1,814 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(gen_server).
+
+%%% ---------------------------------------------------
+%%%
+%%% The idea behind THIS server is that the user module
+%%% provides (different) functions to handle different
+%%% kind of inputs.
+%%% If the Parent process terminates the Module:terminate/2
+%%% function is called.
+%%%
+%%% The user module should export:
+%%%
+%%% init(Args)
+%%% ==> {ok, State}
+%%% {ok, State, Timeout}
+%%% ignore
+%%% {stop, Reason}
+%%%
+%%% handle_call(Msg, {From, Tag}, State)
+%%%
+%%% ==> {reply, Reply, State}
+%%% {reply, Reply, State, Timeout}
+%%% {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, Reply, State}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_cast(Msg, State)
+%%%
+%%% ==> {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ...
+%%%
+%%% ==> {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term, terminate(State) is called
+%%%
+%%% terminate(Reason, State) Let the user module clean up
+%%% always called when server terminates
+%%%
+%%% ==> ok
+%%%
+%%%
+%%% The work flow (of the server) can be described as follows:
+%%%
+%%% User module Generic
+%%% ----------- -------
+%%% start -----> start
+%%% init <----- .
+%%%
+%%% loop
+%%% handle_call <----- .
+%%% -----> reply
+%%%
+%%% handle_cast <----- .
+%%%
+%%% handle_info <----- .
+%%%
+%%% terminate <----- .
+%%%
+%%% -----> reply
+%%%
+%%%
+%%% ---------------------------------------------------
+
+%% API
+-export([start/3, start/4,
+ start_link/3, start_link/4,
+ call/2, call/3,
+ cast/2, reply/2,
+ abcast/2, abcast/3,
+ multi_call/2, multi_call/3, multi_call/4,
+ enter_loop/3, enter_loop/4, enter_loop/5]).
+
+-export([behaviour_info/1]).
+
+%% System exports
+-export([system_continue/3,
+ system_terminate/4,
+ system_code_change/4,
+ format_status/2]).
+
+%% Internal exports
+-export([init_it/6, print_event/3]).
+
+-import(error_logger, [format/2]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+behaviour_info(callbacks) ->
+ [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},
+ {terminate,2},{code_change,3}];
+behaviour_info(_Other) ->
+ undefined.
+
+%%% -----------------------------------------------------------------
+%%% Starts a generic server.
+%%% start(Mod, Args, Options)
+%%% start(Name, Mod, Args, Options)
+%%% start_link(Mod, Args, Options)
+%%% start_link(Name, Mod, Args, Options) where:
+%%% Name ::= {local, atom()} | {global, atom()}
+%%% Mod ::= atom(), callback module implementing the 'real' server
+%%% Args ::= term(), init arguments (to Mod:init/1)
+%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}]
+%%% Flag ::= trace | log | {logfile, File} | statistics | debug
+%%% (debug == log && statistics)
+%%% Returns: {ok, Pid} |
+%%% {error, {already_started, Pid}} |
+%%% {error, Reason}
+%%% -----------------------------------------------------------------
+start(Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Mod, Args, Options).
+
+start(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Name, Mod, Args, Options).
+
+start_link(Mod, Args, Options) ->
+ gen:start(?MODULE, link, Mod, Args, Options).
+
+start_link(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, link, Name, Mod, Args, Options).
+
+
+%% -----------------------------------------------------------------
+%% Make a call to a generic server.
+%% If the server is located at another node, that node will
+%% be monitored.
+%% If the client is trapping exits and is linked server termination
+%% is handled here (? Shall we do that here (or rely on timeouts) ?).
+%% -----------------------------------------------------------------
+call(Name, Request) ->
+ case catch gen:call(Name, '$gen_call', Request) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, call, [Name, Request]}})
+ end.
+
+call(Name, Request, Timeout) ->
+ case catch gen:call(Name, '$gen_call', Request, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, call, [Name, Request, Timeout]}})
+ end.
+
+%% -----------------------------------------------------------------
+%% Make a cast to a generic server.
+%% -----------------------------------------------------------------
+cast({global,Name}, Request) ->
+ catch global:send(Name, cast_msg(Request)),
+ ok;
+cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) ->
+ do_cast(Dest, Request);
+cast(Dest, Request) when is_atom(Dest) ->
+ do_cast(Dest, Request);
+cast(Dest, Request) when is_pid(Dest) ->
+ do_cast(Dest, Request).
+
+do_cast(Dest, Request) ->
+ do_send(Dest, cast_msg(Request)),
+ ok.
+
+cast_msg(Request) -> {'$gen_cast',Request}.
+
+%% -----------------------------------------------------------------
+%% Send a reply to the client.
+%% -----------------------------------------------------------------
+reply({To, Tag}, Reply) ->
+ catch To ! {Tag, Reply}.
+
+%% -----------------------------------------------------------------
+%% Asyncronous broadcast, returns nothing, it's just send'n prey
+%%-----------------------------------------------------------------
+abcast(Name, Request) when is_atom(Name) ->
+ do_abcast([node() | nodes()], Name, cast_msg(Request)).
+
+abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) ->
+ do_abcast(Nodes, Name, cast_msg(Request)).
+
+do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) ->
+ do_send({Name,Node},Msg),
+ do_abcast(Nodes, Name, Msg);
+do_abcast([], _,_) -> abcast.
+
+%%% -----------------------------------------------------------------
+%%% Make a call to servers at several nodes.
+%%% Returns: {[Replies],[BadNodes]}
+%%% A Timeout can be given
+%%%
+%%% A middleman process is used in case late answers arrives after
+%%% the timeout. If they would be allowed to glog the callers message
+%%% queue, it would probably become confused. Late answers will
+%%% now arrive to the terminated middleman and so be discarded.
+%%% -----------------------------------------------------------------
+multi_call(Name, Req)
+ when is_atom(Name) ->
+ do_multi_call([node() | nodes()], Name, Req, infinity).
+
+multi_call(Nodes, Name, Req)
+ when is_list(Nodes), is_atom(Name) ->
+ do_multi_call(Nodes, Name, Req, infinity).
+
+multi_call(Nodes, Name, Req, infinity) ->
+ do_multi_call(Nodes, Name, Req, infinity);
+multi_call(Nodes, Name, Req, Timeout)
+ when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
+ do_multi_call(Nodes, Name, Req, Timeout).
+
+
+%%-----------------------------------------------------------------
+%% enter_loop(Mod, Options, State, , ) ->_
+%%
+%% Description: Makes an existing process into a gen_server.
+%% The calling process will enter the gen_server receive
+%% loop and become a gen_server process.
+%% The process *must* have been started using one of the
+%% start functions in proc_lib, see proc_lib(3).
+%% The user is responsible for any initialization of the
+%% process, including registering a name for it.
+%%-----------------------------------------------------------------
+enter_loop(Mod, Options, State) ->
+ enter_loop(Mod, Options, State, self(), infinity).
+
+enter_loop(Mod, Options, State, ServerName = {_, _}) ->
+ enter_loop(Mod, Options, State, ServerName, infinity);
+
+enter_loop(Mod, Options, State, Timeout) ->
+ enter_loop(Mod, Options, State, self(), Timeout).
+
+enter_loop(Mod, Options, State, ServerName, Timeout) ->
+ Name = get_proc_name(ServerName),
+ Parent = get_parent(),
+ Debug = debug_options(Name, Options),
+ loop(Parent, Name, State, Mod, Timeout, Debug).
+
+%%%========================================================================
+%%% Gen-callback functions
+%%%========================================================================
+
+%%% ---------------------------------------------------
+%%% 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(Starter, self, Name, Mod, Args, Options) ->
+ init_it(Starter, self(), Name, Mod, Args, Options);
+init_it(Starter, Parent, Name, Mod, Args, Options) ->
+ Debug = debug_options(Name, Options),
+ gen:reg_behaviour(?MODULE),
+ case catch Mod:init(Args) of
+ {ok, State} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(Parent, Name, State, Mod, infinity, Debug);
+ {ok, State, Timeout} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(Parent, Name, State, Mod, Timeout, Debug);
+ {stop, Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ ignore ->
+ proc_lib:init_ack(Starter, ignore),
+ exit(normal);
+ {'EXIT', Reason} ->
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ Else ->
+ Error = {bad_return_value, Else},
+ proc_lib:init_ack(Starter, {error, Error}),
+ exit(Error)
+ end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+%%% ---------------------------------------------------
+%%% The MAIN loop.
+%%% ---------------------------------------------------
+loop(Parent, Name, State, Mod, Time, Debug) ->
+ Msg = receive
+ Input ->
+ Input
+ after Time ->
+ timeout
+ end,
+ case Msg of
+ {system, From, Req} ->
+ sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
+ [Name, State, Mod, Time]);
+ {'EXIT', Parent, Reason} ->
+ terminate(Reason, Name, Msg, Mod, State, Debug);
+ _Msg when Debug =:= [] ->
+ handle_msg(Msg, Parent, Name, State, Mod, Time);
+ _Msg ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event},
+ Name, {in, Msg}),
+ handle_msg(Msg, Parent, Name, State, Mod, Time, Debug1)
+ end.
+
+%%% ---------------------------------------------------
+%%% Send/recive functions
+%%% ---------------------------------------------------
+do_send(Dest, Msg) ->
+ case catch erlang:send(Dest, Msg, [noconnect]) of
+ noconnect ->
+ spawn(erlang, send, [Dest,Msg]);
+ Other ->
+ Other
+ end.
+
+do_multi_call(Nodes, Name, Req, infinity) ->
+ Tag = make_ref(),
+ Monitors = send_nodes(Nodes, Name, Tag, Req),
+ rec_nodes(Tag, Monitors, Name, undefined);
+do_multi_call(Nodes, Name, Req, Timeout) ->
+ Tag = make_ref(),
+ Caller = self(),
+ Receiver =
+ spawn(
+ fun() ->
+ %% Middleman process. Should be unsensitive to regular
+ %% exit signals. The sychronization is needed in case
+ %% the receiver would exit before the caller started
+ %% the monitor.
+ process_flag(trap_exit, true),
+ Mref = erlang:monitor(process, Caller),
+ receive
+ {Caller,Tag} ->
+ Monitors = send_nodes(Nodes, Name, Tag, Req),
+ TimerId = erlang:start_timer(Timeout, self(), ok),
+ Result = rec_nodes(Tag, Monitors, Name, TimerId),
+ exit({self(),Tag,Result});
+ {'DOWN',Mref,_,_,_} ->
+ %% Caller died before sending us the go-ahead.
+ %% Give up silently.
+ exit(normal)
+ end
+ end),
+ Mref = erlang:monitor(process, Receiver),
+ Receiver ! {self(),Tag},
+ receive
+ {'DOWN',Mref,_,_,{Receiver,Tag,Result}} ->
+ Result;
+ {'DOWN',Mref,_,_,Reason} ->
+ %% The middleman code failed. Or someone did
+ %% exit(_, kill) on the middleman process => Reason==killed
+ exit(Reason)
+ end.
+
+send_nodes(Nodes, Name, Tag, Req) ->
+ send_nodes(Nodes, Name, Tag, Req, []).
+
+send_nodes([Node|Tail], Name, Tag, Req, Monitors)
+ when is_atom(Node) ->
+ Monitor = start_monitor(Node, Name),
+ %% Handle non-existing names in rec_nodes.
+ catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req},
+ send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]);
+send_nodes([_Node|Tail], Name, Tag, Req, Monitors) ->
+ %% Skip non-atom Node
+ send_nodes(Tail, Name, Tag, Req, Monitors);
+send_nodes([], _Name, _Tag, _Req, Monitors) ->
+ Monitors.
+
+%% Against old nodes:
+%% If no reply has been delivered within 2 secs. (per node) check that
+%% the server really exists and wait for ever for the answer.
+%%
+%% Against contemporary nodes:
+%% Wait for reply, server 'DOWN', or timeout from TimerId.
+
+rec_nodes(Tag, Nodes, Name, TimerId) ->
+ rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId).
+
+rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) ->
+ receive
+ {'DOWN', R, _, _, _} ->
+ rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId);
+ {{Tag, N}, Reply} -> %% Tag is bound !!!
+ unmonitor(R),
+ rec_nodes(Tag, Tail, Name, Badnodes,
+ [{N,Reply}|Replies], Time, TimerId);
+ {timeout, TimerId, _} ->
+ unmonitor(R),
+ %% Collect all replies that already have arrived
+ rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
+ end;
+rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) ->
+ %% R6 node
+ receive
+ {nodedown, N} ->
+ monitor_node(N, false),
+ rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId);
+ {{Tag, N}, Reply} -> %% Tag is bound !!!
+ receive {nodedown, N} -> ok after 0 -> ok end,
+ monitor_node(N, false),
+ rec_nodes(Tag, Tail, Name, Badnodes,
+ [{N,Reply}|Replies], 2000, TimerId);
+ {timeout, TimerId, _} ->
+ receive {nodedown, N} -> ok after 0 -> ok end,
+ monitor_node(N, false),
+ %% Collect all replies that already have arrived
+ rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies)
+ after Time ->
+ case rpc:call(N, erlang, whereis, [Name]) of
+ Pid when is_pid(Pid) -> % It exists try again.
+ rec_nodes(Tag, [N|Tail], Name, Badnodes,
+ Replies, infinity, TimerId);
+ _ -> % badnode
+ receive {nodedown, N} -> ok after 0 -> ok end,
+ monitor_node(N, false),
+ rec_nodes(Tag, Tail, Name, [N|Badnodes],
+ Replies, 2000, TimerId)
+ end
+ end;
+rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) ->
+ case catch erlang:cancel_timer(TimerId) of
+ false -> % It has already sent it's message
+ receive
+ {timeout, TimerId, _} -> ok
+ after 0 ->
+ ok
+ end;
+ _ -> % Timer was cancelled, or TimerId was 'undefined'
+ ok
+ end,
+ {Replies, Badnodes}.
+
+%% Collect all replies that already have arrived
+rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) ->
+ receive
+ {'DOWN', R, _, _, _} ->
+ rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
+ {{Tag, N}, Reply} -> %% Tag is bound !!!
+ unmonitor(R),
+ rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
+ after 0 ->
+ unmonitor(R),
+ rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
+ end;
+rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) ->
+ %% R6 node
+ receive
+ {nodedown, N} ->
+ monitor_node(N, false),
+ rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
+ {{Tag, N}, Reply} -> %% Tag is bound !!!
+ receive {nodedown, N} -> ok after 0 -> ok end,
+ monitor_node(N, false),
+ rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
+ after 0 ->
+ receive {nodedown, N} -> ok after 0 -> ok end,
+ monitor_node(N, false),
+ rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
+ end;
+rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) ->
+ {Replies, Badnodes}.
+
+
+%%% ---------------------------------------------------
+%%% Monitor functions
+%%% ---------------------------------------------------
+
+start_monitor(Node, Name) when is_atom(Node), is_atom(Name) ->
+ if node() =:= nonode@nohost, Node =/= nonode@nohost ->
+ Ref = make_ref(),
+ self() ! {'DOWN', Ref, process, {Name, Node}, noconnection},
+ {Node, Ref};
+ true ->
+ case catch erlang:monitor(process, {Name, Node}) of
+ {'EXIT', _} ->
+ %% Remote node is R6
+ monitor_node(Node, true),
+ Node;
+ Ref when is_reference(Ref) ->
+ {Node, Ref}
+ end
+ end.
+
+%% Cancels a monitor started with Ref=erlang:monitor(_, _).
+unmonitor(Ref) when is_reference(Ref) ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, _, _, _} ->
+ true
+ after 0 ->
+ true
+ end.
+
+%%% ---------------------------------------------------
+%%% Message handling functions
+%%% ---------------------------------------------------
+
+dispatch({'$gen_cast', Msg}, Mod, State) ->
+ Mod:handle_cast(Msg, State);
+dispatch(Info, Mod, State) ->
+ Mod:handle_info(Info, State).
+
+handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, _Time) ->
+ case catch Mod:handle_call(Msg, From, State) of
+ {reply, Reply, NState} ->
+ reply(From, Reply),
+ loop(Parent, Name, NState, Mod, infinity, []);
+ {reply, Reply, NState, Time1} ->
+ reply(From, Reply),
+ loop(Parent, Name, NState, Mod, Time1, []);
+ {noreply, NState} ->
+ loop(Parent, Name, NState, Mod, infinity, []);
+ {noreply, NState, Time1} ->
+ loop(Parent, Name, NState, Mod, Time1, []);
+ {stop, Reason, Reply, NState} ->
+ {'EXIT', R} =
+ (catch terminate(Reason, Name, Msg, Mod, NState, [])),
+ reply(From, Reply),
+ exit(R);
+ Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State)
+ end;
+handle_msg(Msg, Parent, Name, State, Mod, _Time) ->
+ Reply = (catch dispatch(Msg, Mod, State)),
+ handle_common_reply(Reply, Parent, Name, Msg, Mod, State).
+
+handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, _Time, Debug) ->
+ case catch Mod:handle_call(Msg, From, State) of
+ {reply, Reply, NState} ->
+ Debug1 = reply(Name, From, Reply, NState, Debug),
+ loop(Parent, Name, NState, Mod, infinity, Debug1);
+ {reply, Reply, NState, Time1} ->
+ Debug1 = reply(Name, From, Reply, NState, Debug),
+ loop(Parent, Name, NState, Mod, Time1, Debug1);
+ {noreply, NState} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {noreply, NState}),
+ loop(Parent, Name, NState, Mod, infinity, Debug1);
+ {noreply, NState, Time1} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {noreply, NState}),
+ loop(Parent, Name, NState, Mod, Time1, Debug1);
+ {stop, Reason, Reply, NState} ->
+ {'EXIT', R} =
+ (catch terminate(Reason, Name, Msg, Mod, NState, Debug)),
+ reply(Name, From, Reply, NState, Debug),
+ exit(R);
+ Other ->
+ handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug)
+ end;
+handle_msg(Msg, Parent, Name, State, Mod, _Time, Debug) ->
+ Reply = (catch dispatch(Msg, Mod, State)),
+ handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug).
+
+handle_common_reply(Reply, Parent, Name, Msg, Mod, State) ->
+ case Reply of
+ {noreply, NState} ->
+ loop(Parent, Name, NState, Mod, infinity, []);
+ {noreply, NState, Time1} ->
+ loop(Parent, Name, NState, Mod, Time1, []);
+ {stop, Reason, NState} ->
+ terminate(Reason, Name, Msg, Mod, NState, []);
+ {'EXIT', What} ->
+ terminate(What, Name, Msg, Mod, State, []);
+ _ ->
+ terminate({bad_return_value, Reply}, Name, Msg, Mod, State, [])
+ end.
+
+handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) ->
+ case Reply of
+ {noreply, NState} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {noreply, NState}),
+ loop(Parent, Name, NState, Mod, infinity, Debug1);
+ {noreply, NState, Time1} ->
+ Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {noreply, NState}),
+ loop(Parent, Name, NState, Mod, Time1, Debug1);
+ {stop, Reason, NState} ->
+ terminate(Reason, Name, Msg, Mod, NState, Debug);
+ {'EXIT', What} ->
+ terminate(What, Name, Msg, Mod, State, Debug);
+ _ ->
+ terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug)
+ end.
+
+reply(Name, {To, Tag}, Reply, State, Debug) ->
+ reply({To, Tag}, Reply),
+ sys:handle_debug(Debug, {?MODULE, print_event}, Name,
+ {out, Reply, To, State} ).
+
+
+%%-----------------------------------------------------------------
+%% Callback functions for system messages handling.
+%%-----------------------------------------------------------------
+system_continue(Parent, Debug, [Name, State, Mod, Time]) ->
+ loop(Parent, Name, State, Mod, Time, Debug).
+
+system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time]) ->
+ terminate(Reason, Name, [], Mod, State, Debug).
+
+system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) ->
+ case catch Mod:code_change(OldVsn, State, Extra) of
+ {ok, NewState} -> {ok, [Name, NewState, Mod, Time]};
+ Else -> Else
+ end.
+
+%%-----------------------------------------------------------------
+%% Format debug messages. Print them as the call-back module sees
+%% them, not as the real erlang messages. Use trace for that.
+%%-----------------------------------------------------------------
+print_event(Dev, {in, Msg}, Name) ->
+ case Msg of
+ {'$gen_call', {From, _Tag}, Call} ->
+ io:format(Dev, "*DBG* ~p got call ~p from ~w~n",
+ [Name, Call, From]);
+ {'$gen_cast', Cast} ->
+ io:format(Dev, "*DBG* ~p got cast ~p~n",
+ [Name, Cast]);
+ _ ->
+ io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
+ end;
+print_event(Dev, {out, Msg, To, State}, Name) ->
+ io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n",
+ [Name, Msg, To, State]);
+print_event(Dev, {noreply, State}, Name) ->
+ io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);
+print_event(Dev, Event, Name) ->
+ io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]).
+
+
+%%% ---------------------------------------------------
+%%% Terminate the server.
+%%% ---------------------------------------------------
+
+terminate(Reason, Name, Msg, Mod, State, Debug) ->
+ case catch Mod:terminate(Reason, State) of
+ {'EXIT', R} ->
+ error_info(R, Name, Msg, State, Debug),
+ exit(R);
+ _ ->
+ case Reason of
+ normal ->
+ exit(normal);
+ shutdown ->
+ exit(shutdown);
+ _ ->
+ error_info(Reason, Name, Msg, State, Debug),
+ exit(Reason)
+ end
+ end.
+
+error_info(_Reason, application_controller, _Msg, _State, _Debug) ->
+ %% OTP-5811 Don't send an error report if it's the system process
+ %% application_controller which is terminating - let init take care
+ %% of it instead
+ ok;
+error_info(Reason, Name, Msg, State, Debug) ->
+ Reason1 =
+ case Reason of
+ {undef,[{M,F,A}|MFAs]} ->
+ case code:is_loaded(M) of
+ false ->
+ {'module could not be loaded',[{M,F,A}|MFAs]};
+ _ ->
+ case erlang:function_exported(M, F, length(A)) of
+ true ->
+ Reason;
+ false ->
+ {'function not exported',[{M,F,A}|MFAs]}
+ end
+ end;
+ _ ->
+ Reason
+ end,
+ format("** Generic server ~p terminating \n"
+ "** Last message in was ~p~n"
+ "** When Server state == ~p~n"
+ "** Reason for termination == ~n** ~p~n",
+ [Name, Msg, State, Reason1]),
+ sys:print_log(Debug),
+ ok.
+
+%%% ---------------------------------------------------
+%%% Misc. functions.
+%%% ---------------------------------------------------
+
+opt(Op, [{Op, Value}|_]) ->
+ {ok, Value};
+opt(Op, [_|Options]) ->
+ opt(Op, Options);
+opt(_, []) ->
+ false.
+
+debug_options(Name, Opts) ->
+ case opt(debug, Opts) of
+ {ok, Options} -> dbg_options(Name, Options);
+ _ -> dbg_options(Name, [])
+ end.
+
+dbg_options(Name, []) ->
+ Opts =
+ case init:get_argument(generic_debug) of
+ error ->
+ [];
+ _ ->
+ [log, statistics]
+ end,
+ dbg_opts(Name, Opts);
+dbg_options(Name, Opts) ->
+ dbg_opts(Name, Opts).
+
+dbg_opts(Name, Opts) ->
+ case catch sys:debug_options(Opts) of
+ {'EXIT',_} ->
+ format("~p: ignoring erroneous debug options - ~p~n",
+ [Name, Opts]),
+ [];
+ Dbg ->
+ Dbg
+ end.
+
+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:safe_whereis_name(Name) of
+ undefined ->
+ exit(process_not_registered_globally);
+ Pid when Pid =:= self() ->
+ Name;
+ _Pid ->
+ exit(process_not_registered_globally)
+ 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:safe_whereis_name(Name) of
+ undefined ->
+ exit(could_not_find_registerd_name);
+ Pid ->
+ Pid
+ end;
+ Pid ->
+ Pid
+ end.
+
+%%-----------------------------------------------------------------
+%% Status information
+%%-----------------------------------------------------------------
+format_status(Opt, StatusData) ->
+ [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData,
+ NameTag = if is_pid(Name) ->
+ pid_to_list(Name);
+ is_atom(Name) ->
+ Name
+ end,
+ Header = lists:concat(["Status for generic server ", NameTag]),
+ Log = sys:get_debug(log, Debug, []),
+ Specfic =
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ case catch Mod:format_status(Opt, [PDict, State]) of
+ {'EXIT', _} -> [{data, [{"State", State}]}];
+ Else -> Else
+ end;
+ _ ->
+ [{data, [{"State", State}]}]
+ end,
+ [{header, Header},
+ {data, [{"Status", SysState},
+ {"Parent", Parent},
+ {"Logged events", Log}]} |
+ Specfic].
diff --git a/patches/stdlib/supervisor.erl b/patches/stdlib/supervisor.erl
new file mode 100644
index 0000000..fac763d
--- /dev/null
+++ b/patches/stdlib/supervisor.erl
@@ -0,0 +1,934 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(supervisor).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/2,start_link/3,
+ start_child/2, restart_child/2,
+ delete_child/2, terminate_child/2,
+ which_children/1,
+ check_childspecs/1]).
+
+-export([behaviour_info/1]).
+
+%% Internal exports
+-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
+-export([handle_cast/2]).
+
+-define(DICT, dict).
+
+
+
+-record(state, {name,
+ strategy,
+ children = [],
+ dynamics = ?DICT:new(),
+ intensity,
+ period,
+ restarts = [],
+ module,
+ args}).
+
+-record(child, {pid = undefined, % pid is undefined when child is not running
+ name,
+ mfa,
+ restart_type,
+ shutdown,
+ child_type,
+ modules = []}).
+
+-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
+
+behaviour_info(callbacks) ->
+ [{init,1}];
+behaviour_info(_Other) ->
+ undefined.
+
+%%% ---------------------------------------------------
+%%% This is a general process supervisor built upon gen_server.erl.
+%%% Servers/processes should/could also be built using gen_server.erl.
+%%% SupName = {local, atom()} | {global, atom()}.
+%%% ---------------------------------------------------
+start_link(Mod, Args) ->
+ gen_server:start_link(supervisor, {self, Mod, Args}, []).
+
+start_link(SupName, Mod, Args) ->
+ gen_server:start_link(SupName, supervisor, {SupName, Mod, Args}, []).
+
+%%% ---------------------------------------------------
+%%% Interface functions.
+%%% ---------------------------------------------------
+start_child(Supervisor, ChildSpec) ->
+ call(Supervisor, {start_child, ChildSpec}).
+
+restart_child(Supervisor, Name) ->
+ call(Supervisor, {restart_child, Name}).
+
+delete_child(Supervisor, Name) ->
+ call(Supervisor, {delete_child, Name}).
+
+%%-----------------------------------------------------------------
+%% Func: terminate_child/2
+%% Returns: ok | {error, Reason}
+%% Note that the child is *always* terminated in some
+%% way (maybe killed).
+%%-----------------------------------------------------------------
+terminate_child(Supervisor, Name) ->
+ call(Supervisor, {terminate_child, Name}).
+
+which_children(Supervisor) ->
+ call(Supervisor, which_children).
+
+call(Supervisor, Req) ->
+ gen_server:call(Supervisor, Req, infinity).
+
+check_childspecs(ChildSpecs) when is_list(ChildSpecs) ->
+ case check_startspec(ChildSpecs) of
+ {ok, _} -> ok;
+ Error -> {error, Error}
+ end;
+check_childspecs(X) -> {error, {badarg, X}}.
+
+%%% ---------------------------------------------------
+%%%
+%%% Initialize the supervisor.
+%%%
+%%% ---------------------------------------------------
+init({SupName, Mod, Args}) ->
+ process_flag(trap_exit, true),
+ gen:reg_behaviour(?MODULE),
+ case Mod:init(Args) of
+ {ok, {SupFlags, StartSpec}} ->
+ gproc:reg({p,l,supflags}, SupFlags),
+ case init_state(SupName, SupFlags, Mod, Args) of
+ {ok, State} when ?is_simple(State) ->
+ init_dynamic(State, StartSpec);
+ {ok, State} ->
+ init_children(State, StartSpec);
+ Error ->
+ {stop, {supervisor_data, Error}}
+ end;
+ ignore ->
+ ignore;
+ Error ->
+ {stop, {bad_return, {Mod, init, Error}}}
+ end.
+
+init_children(State, StartSpec) ->
+ SupName = State#state.name,
+ case check_startspec(StartSpec) of
+ {ok, Children} ->
+ reg_children(Children),
+ case start_children(Children, SupName) of
+ {ok, NChildren} ->
+ set_children(NChildren),
+ {ok, State#state{children = NChildren}};
+ {error, NChildren} ->
+ terminate_children(NChildren, SupName),
+ {stop, shutdown}
+ end;
+ Error ->
+ {stop, {start_spec, Error}}
+ end.
+
+
+reg_children(Children) ->
+ lists:foreach(
+ fun(Ch) ->
+ gproc:reg({p,l,{childspec,Ch#child.name}}, Ch)
+ end, Children).
+
+set_children(Children) ->
+ lists:foreach(
+ fun(Ch) ->
+ gproc:set_value({p,l,{childspec,Ch#child.name}}, Ch)
+ end, Children).
+
+unreg_child(Child) ->
+ gproc:unreg({p,l,{childspec,Child#child.name}}).
+
+set_child(Child) ->
+ catch gproc:set_value({p,l,{childspec,Child#child.name}}, Child).
+
+
+
+init_dynamic(State, [StartSpec]) ->
+ case check_startspec([StartSpec]) of
+ {ok, Children} ->
+ reg_children(Children),
+ {ok, State#state{children = Children}};
+ Error ->
+ {stop, {start_spec, Error}}
+ end;
+init_dynamic(_State, StartSpec) ->
+ {stop, {bad_start_spec, StartSpec}}.
+
+%%-----------------------------------------------------------------
+%% Func: start_children/2
+%% Args: Children = [#child] in start order
+%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
+%% Purpose: Start all children. The new list contains #child's
+%% with pids.
+%% Returns: {ok, NChildren} | {error, NChildren}
+%% NChildren = [#child] in termination order (reversed
+%% start order)
+%%-----------------------------------------------------------------
+start_children(Children, SupName) -> start_children(Children, [], SupName).
+
+start_children([Child|Chs], NChildren, SupName) ->
+ case do_start_child(SupName, Child) of
+ {ok, Pid} ->
+ start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
+ {ok, Pid, _Extra} ->
+ start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
+ {error, Reason} ->
+ report_error(start_error, Reason, Child, SupName),
+ {error, lists:reverse(Chs) ++ [Child | NChildren]}
+ end;
+start_children([], NChildren, _SupName) ->
+ {ok, NChildren}.
+
+do_start_child(SupName, Child) ->
+ #child{mfa = {M, F, A}} = Child,
+ case catch apply(M, F, A) of
+ {ok, Pid} when is_pid(Pid) ->
+ NChild = Child#child{pid = Pid},
+ report_progress(NChild, SupName),
+ {ok, Pid};
+ {ok, Pid, Extra} when is_pid(Pid) ->
+ NChild = Child#child{pid = Pid},
+ report_progress(NChild, SupName),
+ {ok, Pid, Extra};
+ ignore ->
+ {ok, undefined};
+ {error, What} -> {error, What};
+ What -> {error, What}
+ end.
+
+do_start_child_i(M, F, A) ->
+ case catch apply(M, F, A) of
+ {ok, Pid} when is_pid(Pid) ->
+ {ok, Pid};
+ {ok, Pid, Extra} when is_pid(Pid) ->
+ {ok, Pid, Extra};
+ ignore ->
+ {ok, undefined};
+ {error, Error} ->
+ {error, Error};
+ What ->
+ {error, What}
+ end.
+
+
+%%% ---------------------------------------------------
+%%%
+%%% Callback functions.
+%%%
+%%% ---------------------------------------------------
+handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
+ #child{mfa = {M, F, A}} = hd(State#state.children),
+ Args = A ++ EArgs,
+ case do_start_child_i(M, F, Args) of
+ {ok, Pid} ->
+ gproc:reg({p,l,{simple_child,Pid}}, Args),
+ NState = State#state{dynamics =
+ ?DICT:store(Pid, Args, State#state.dynamics)},
+ {reply, {ok, Pid}, NState};
+ {ok, Pid, Extra} ->
+ gproc:reg({p,l,{simple_child,Pid}}, Args),
+ NState = State#state{dynamics =
+ ?DICT:store(Pid, Args, State#state.dynamics)},
+ {reply, {ok, Pid, Extra}, NState};
+ What ->
+ {reply, What, State}
+ end;
+
+%%% The requests terminate_child, delete_child and restart_child are
+%%% invalid for simple_one_for_one supervisors.
+handle_call({_Req, _Data}, _From, State) when ?is_simple(State) ->
+ {reply, {error, simple_one_for_one}, State};
+
+handle_call({start_child, ChildSpec}, _From, State) ->
+ case check_childspec(ChildSpec) of
+ {ok, Child} ->
+ {Resp, NState} = handle_start_child(Child, State),
+ {reply, Resp, NState};
+ What ->
+ {reply, {error, What}, State}
+ end;
+
+handle_call({restart_child, Name}, _From, State) ->
+ case get_child(Name, State) of
+ {value, Child} when Child#child.pid =:= undefined ->
+ case do_start_child(State#state.name, Child) of
+ {ok, Pid} ->
+ NState = replace_child(Child#child{pid = Pid}, State),
+ {reply, {ok, Pid}, NState};
+ {ok, Pid, Extra} ->
+ NState = replace_child(Child#child{pid = Pid}, State),
+ {reply, {ok, Pid, Extra}, NState};
+ Error ->
+ {reply, Error, State}
+ end;
+ {value, _} ->
+ {reply, {error, running}, State};
+ _ ->
+ {reply, {error, not_found}, State}
+ end;
+
+handle_call({delete_child, Name}, _From, State) ->
+ case get_child(Name, State) of
+ {value, Child} when Child#child.pid =:= undefined ->
+ NState = remove_child(Child, State),
+ {reply, ok, NState};
+ {value, _} ->
+ {reply, {error, running}, State};
+ _ ->
+ {reply, {error, not_found}, State}
+ end;
+
+handle_call({terminate_child, Name}, _From, State) ->
+ case get_child(Name, State) of
+ {value, Child} ->
+ NChild = do_terminate(Child, State#state.name),
+ {reply, ok, replace_child(NChild, State)};
+ _ ->
+ {reply, {error, not_found}, State}
+ end;
+
+handle_call(which_children, _From, State) when ?is_simple(State) ->
+ [#child{child_type = CT, modules = Mods}] = State#state.children,
+ Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end,
+ ?DICT:to_list(State#state.dynamics)),
+ {reply, Reply, State};
+
+handle_call(which_children, _From, State) ->
+ Resp =
+ lists:map(fun(#child{pid = Pid, name = Name,
+ child_type = ChildType, modules = Mods}) ->
+ {Name, Pid, ChildType, Mods}
+ end,
+ State#state.children),
+ {reply, Resp, State}.
+
+
+%%% Hopefully cause a function-clause as there is no API function
+%%% that utilizes cast.
+handle_cast(null, State) ->
+ error_logger:error_msg("ERROR: Supervisor received cast-message 'null'~n",
+ []),
+
+ {noreply, State}.
+
+%%
+%% Take care of terminated children.
+%%
+handle_info({'EXIT', Pid, Reason}, State) ->
+ case restart_child(Pid, Reason, State) of
+ {ok, State1} ->
+ {noreply, State1};
+ {shutdown, State1} ->
+ {stop, shutdown, State1}
+ end;
+
+handle_info(Msg, State) ->
+ error_logger:error_msg("Supervisor received unexpected message: ~p~n",
+ [Msg]),
+ {noreply, State}.
+%%
+%% Terminate this server.
+%%
+terminate(_Reason, State) ->
+ terminate_children(State#state.children, State#state.name),
+ ok.
+
+%%
+%% Change code for the supervisor.
+%% Call the new call-back module and fetch the new start specification.
+%% Combine the new spec. with the old. If the new start spec. is
+%% not valid the code change will not succeed.
+%% Use the old Args as argument to Module:init/1.
+%% NOTE: This requires that the init function of the call-back module
+%% does not have any side effects.
+%%
+code_change(_, State, _) ->
+ case (State#state.module):init(State#state.args) of
+ {ok, {SupFlags, StartSpec}} ->
+ case catch check_flags(SupFlags) of
+ ok ->
+ {Strategy, MaxIntensity, Period} = SupFlags,
+ update_childspec(State#state{strategy = Strategy,
+ intensity = MaxIntensity,
+ period = Period},
+ StartSpec);
+ Error ->
+ {error, Error}
+ end;
+ ignore ->
+ {ok, State};
+ Error ->
+ Error
+ end.
+
+check_flags({Strategy, MaxIntensity, Period}) ->
+ validStrategy(Strategy),
+ validIntensity(MaxIntensity),
+ validPeriod(Period),
+ ok;
+check_flags(What) ->
+ {bad_flags, What}.
+
+update_childspec(State, StartSpec) when ?is_simple(State) ->
+ case check_startspec(StartSpec) of
+ {ok, [Child]} ->
+ set_children([Child]),
+ {ok, State#state{children = [Child]}};
+ Error ->
+ {error, Error}
+ end;
+
+update_childspec(State, StartSpec) ->
+ case check_startspec(StartSpec) of
+ {ok, Children} ->
+ OldC = State#state.children, % In reverse start order !
+ NewC = update_childspec1(OldC, Children, []),
+ set_children(NewC),
+ {ok, State#state{children = NewC}};
+ Error ->
+ {error, Error}
+ end.
+
+update_childspec1([Child|OldC], Children, KeepOld) ->
+ case update_chsp(Child, Children) of
+ {ok,NewChildren} ->
+ update_childspec1(OldC, NewChildren, KeepOld);
+ false ->
+ update_childspec1(OldC, Children, [Child|KeepOld])
+ end;
+update_childspec1([], Children, KeepOld) ->
+ % Return them in (keeped) reverse start order.
+ lists:reverse(Children ++ KeepOld).
+
+update_chsp(OldCh, Children) ->
+ case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name ->
+ Ch#child{pid = OldCh#child.pid};
+ (Ch) ->
+ Ch
+ end,
+ Children) of
+ Children ->
+ false; % OldCh not found in new spec.
+ NewC ->
+ {ok, NewC}
+ end.
+
+%%% ---------------------------------------------------
+%%% Start a new child.
+%%% ---------------------------------------------------
+
+handle_start_child(Child, State) ->
+ case get_child(Child#child.name, State) of
+ false ->
+ case do_start_child(State#state.name, Child) of
+ {ok, Pid} ->
+ Children = State#state.children,
+ NewChild = Child#child{pid = Pid},
+ NewC = [NewChild|Children],
+ set_child(NewChild),
+ {{ok, Pid},
+ State#state{children = NewC}};
+ {ok, Pid, Extra} ->
+ Children = State#state.children,
+ NewChild = Child#child{pid = Pid},
+ NewC = [NewChild|Children],
+ set_child(NewChild),
+ {{ok, Pid, Extra},
+ State#state{children = NewC}};
+ {error, What} ->
+ {{error, {What, Child}}, State}
+ end;
+ {value, OldChild} when OldChild#child.pid =/= undefined ->
+ {{error, {already_started, OldChild#child.pid}}, State};
+ {value, _OldChild} ->
+ {{error, already_present}, State}
+ end.
+
+%%% ---------------------------------------------------
+%%% Restart. A process has terminated.
+%%% Returns: {ok, #state} | {shutdown, #state}
+%%% ---------------------------------------------------
+
+restart_child(Pid, Reason, State) when ?is_simple(State) ->
+ case ?DICT:find(Pid, State#state.dynamics) of
+ {ok, Args} ->
+ [Child] = State#state.children,
+ RestartType = Child#child.restart_type,
+ {M, F, _} = Child#child.mfa,
+ NChild = Child#child{pid = Pid, mfa = {M, F, Args}},
+ do_restart(RestartType, Reason, NChild, State);
+ error ->
+ {ok, State}
+ end;
+restart_child(Pid, Reason, State) ->
+ Children = State#state.children,
+ case lists:keysearch(Pid, #child.pid, Children) of
+ {value, Child} ->
+ RestartType = Child#child.restart_type,
+ do_restart(RestartType, Reason, Child, State);
+ _ ->
+ {ok, State}
+ end.
+
+do_restart(permanent, Reason, Child, State) ->
+ report_error(child_terminated, Reason, Child, State#state.name),
+ restart(Child, State);
+do_restart(_, normal, Child, State) ->
+ NState = state_del_child(Child, State),
+ {ok, NState};
+do_restart(_, shutdown, Child, State) ->
+ NState = state_del_child(Child, State),
+ {ok, NState};
+do_restart(transient, Reason, Child, State) ->
+ report_error(child_terminated, Reason, Child, State#state.name),
+ restart(Child, State);
+do_restart(temporary, Reason, Child, State) ->
+ report_error(child_terminated, Reason, Child, State#state.name),
+ NState = state_del_child(Child, State),
+ {ok, NState}.
+
+restart(Child, State) ->
+ case add_restart(State) of
+ {ok, NState} ->
+ restart(NState#state.strategy, Child, NState);
+ {terminate, NState} ->
+ report_error(shutdown, reached_max_restart_intensity,
+ Child, State#state.name),
+ {shutdown, remove_child(Child, NState)}
+ end.
+
+restart(simple_one_for_one, Child, State) ->
+ #child{mfa = {M, F, A}} = Child,
+ Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics),
+ case do_start_child_i(M, F, A) of
+ {ok, Pid} ->
+ NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)},
+ {ok, NState};
+ {ok, Pid, _Extra} ->
+ NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)},
+ {ok, NState};
+ {error, Error} ->
+ report_error(start_error, Error, Child, State#state.name),
+ restart(Child, State)
+ end;
+restart(one_for_one, Child, State) ->
+ case do_start_child(State#state.name, Child) of
+ {ok, Pid} ->
+ NState = replace_child(Child#child{pid = Pid}, State),
+ {ok, NState};
+ {ok, Pid, _Extra} ->
+ NState = replace_child(Child#child{pid = Pid}, State),
+ {ok, NState};
+ {error, Reason} ->
+ report_error(start_error, Reason, Child, State#state.name),
+ restart(Child, State)
+ end;
+restart(rest_for_one, Child, State) ->
+ {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children),
+ ChAfter2 = terminate_children(ChAfter, State#state.name),
+ case start_children(ChAfter2, State#state.name) of
+ {ok, ChAfter3} ->
+ NewC = ChAfter3 ++ ChBefore,
+ {ok, State#state{children = NewC}};
+ {error, ChAfter3} ->
+ NewC = ChAfter3 ++ ChBefore,
+ restart(Child, State#state{children = NewC})
+ end;
+restart(one_for_all, Child, State) ->
+ Children1 = del_child(Child#child.pid, State#state.children),
+ Children2 = terminate_children(Children1, State#state.name),
+ case start_children(Children2, State#state.name) of
+ {ok, NChs} ->
+ {ok, State#state{children = NChs}};
+ {error, NChs} ->
+ restart(Child, State#state{children = NChs})
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: terminate_children/2
+%% Args: Children = [#child] in termination order
+%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
+%% Returns: NChildren = [#child] in
+%% startup order (reversed termination order)
+%%-----------------------------------------------------------------
+terminate_children(Children, SupName) ->
+ terminate_children(Children, SupName, []).
+
+terminate_children([Child | Children], SupName, Res) ->
+ NChild = do_terminate(Child, SupName),
+ set_child(NChild),
+ terminate_children(Children, SupName, [NChild | Res]);
+terminate_children([], _SupName, Res) ->
+ Res.
+
+do_terminate(Child, SupName) when Child#child.pid =/= undefined ->
+ case shutdown(Child#child.pid,
+ Child#child.shutdown) of
+ ok ->
+ Child#child{pid = undefined};
+ {error, OtherReason} ->
+ report_error(shutdown_error, OtherReason, Child, SupName),
+ Child#child{pid = undefined}
+ end;
+do_terminate(Child, _SupName) ->
+ Child.
+
+%%-----------------------------------------------------------------
+%% Shutdowns a child. We must check the EXIT value
+%% of the child, because it might have died with another reason than
+%% the wanted. In that case we want to report the error. We put a
+%% monitor on the child an check for the 'DOWN' message instead of
+%% checking for the 'EXIT' message, because if we check the 'EXIT'
+%% message a "naughty" child, who does unlink(Sup), could hang the
+%% supervisor.
+%% Returns: ok | {error, OtherReason} (this should be reported)
+%%-----------------------------------------------------------------
+shutdown(Pid, brutal_kill) ->
+
+ case monitor_child(Pid) of
+ ok ->
+ exit(Pid, kill),
+ receive
+ {'DOWN', _MRef, process, Pid, killed} ->
+ ok;
+ {'DOWN', _MRef, process, Pid, OtherReason} ->
+ {error, OtherReason}
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end;
+
+shutdown(Pid, Time) ->
+
+ case monitor_child(Pid) of
+ ok ->
+ exit(Pid, shutdown), %% Try to shutdown gracefully
+ receive
+ {'DOWN', _MRef, process, Pid, shutdown} ->
+ ok;
+ {'DOWN', _MRef, process, Pid, OtherReason} ->
+ {error, OtherReason}
+ after Time ->
+ exit(Pid, kill), %% Force termination.
+ receive
+ {'DOWN', _MRef, process, Pid, OtherReason} ->
+ {error, OtherReason}
+ end
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+%% Help function to shutdown/2 switches from link to monitor approach
+monitor_child(Pid) ->
+
+ %% Do the monitor operation first so that if the child dies
+ %% before the monitoring is done causing a 'DOWN'-message with
+ %% reason noproc, we will get the real reason in the 'EXIT'-message
+ %% unless a naughty child has already done unlink...
+ erlang:monitor(process, Pid),
+ unlink(Pid),
+
+ receive
+ %% If the child dies before the unlik we must empty
+ %% the mail-box of the 'EXIT'-message and the 'DOWN'-message.
+ {'EXIT', Pid, Reason} ->
+ receive
+ {'DOWN', _, process, Pid, _} ->
+ {error, Reason}
+ end
+ after 0 ->
+ %% If a naughty child did unlink and the child dies before
+ %% monitor the result will be that shutdown/2 receives a
+ %% 'DOWN'-message with reason noproc.
+ %% If the child should die after the unlink there
+ %% will be a 'DOWN'-message with a correct reason
+ %% that will be handled in shutdown/2.
+ ok
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Child/State manipulating functions.
+%%-----------------------------------------------------------------
+state_del_child(#child{pid = Pid}, State) when ?is_simple(State) ->
+ gproc:unreg({p,l,{simple_child,Pid}}),
+ NDynamics = ?DICT:erase(Pid, State#state.dynamics),
+ State#state{dynamics = NDynamics};
+state_del_child(Child, State) ->
+ NChildren = del_child(Child#child.name, State#state.children),
+ State#state{children = NChildren}.
+
+del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name ->
+ NewCh = Ch#child{pid = undefined},
+ set_child(NewCh),
+ [NewCh | Chs];
+del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid ->
+ NewCh = Ch#child{pid = undefined},
+ set_child(NewCh),
+ [NewCh | Chs];
+del_child(Name, [Ch|Chs]) ->
+ [Ch|del_child(Name, Chs)];
+del_child(_, []) ->
+ [].
+
+%% Chs = [S4, S3, Ch, S1, S0]
+%% Ret: {[S4, S3, Ch], [S1, S0]}
+split_child(Name, Chs) ->
+ split_child(Name, Chs, []).
+
+split_child(Name, [Ch|Chs], After) when Ch#child.name =:= Name ->
+ {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
+split_child(Pid, [Ch|Chs], After) when Ch#child.pid =:= Pid ->
+ {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
+split_child(Name, [Ch|Chs], After) ->
+ split_child(Name, Chs, [Ch | After]);
+split_child(_, [], After) ->
+ {lists:reverse(After), []}.
+
+get_child(Name, State) ->
+ lists:keysearch(Name, #child.name, State#state.children).
+replace_child(Child, State) ->
+ Chs = do_replace_child(Child, State#state.children),
+ State#state{children = Chs}.
+
+do_replace_child(Child, [Ch|Chs]) when Ch#child.name =:= Child#child.name ->
+ set_child(Child),
+ [Child | Chs];
+do_replace_child(Child, [Ch|Chs]) ->
+ [Ch|do_replace_child(Child, Chs)].
+
+remove_child(Child, State) ->
+ Chs = lists:keydelete(Child#child.name, #child.name, State#state.children),
+ unreg_child(Child),
+ State#state{children = Chs}.
+
+%%-----------------------------------------------------------------
+%% Func: init_state/4
+%% Args: SupName = {local, atom()} | {global, atom()} | self
+%% Type = {Strategy, MaxIntensity, Period}
+%% Strategy = one_for_one | one_for_all | simple_one_for_one |
+%% rest_for_one
+%% MaxIntensity = integer()
+%% Period = integer()
+%% Mod :== atom()
+%% Arsg :== term()
+%% Purpose: Check that Type is of correct type (!)
+%% Returns: {ok, #state} | Error
+%%-----------------------------------------------------------------
+init_state(SupName, Type, Mod, Args) ->
+ case catch init_state1(SupName, Type, Mod, Args) of
+ {ok, State} ->
+ {ok, State};
+ Error ->
+ Error
+ end.
+
+init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) ->
+ validStrategy(Strategy),
+ validIntensity(MaxIntensity),
+ validPeriod(Period),
+ {ok, #state{name = supname(SupName,Mod),
+ strategy = Strategy,
+ intensity = MaxIntensity,
+ period = Period,
+ module = Mod,
+ args = Args}};
+init_state1(_SupName, Type, _, _) ->
+ {invalid_type, Type}.
+
+validStrategy(simple_one_for_one) -> true;
+validStrategy(one_for_one) -> true;
+validStrategy(one_for_all) -> true;
+validStrategy(rest_for_one) -> true;
+validStrategy(What) -> throw({invalid_strategy, What}).
+
+validIntensity(Max) when is_integer(Max),
+ Max >= 0 -> true;
+validIntensity(What) -> throw({invalid_intensity, What}).
+
+validPeriod(Period) when is_integer(Period),
+ Period > 0 -> true;
+validPeriod(What) -> throw({invalid_period, What}).
+
+supname(self,Mod) -> {self(),Mod};
+supname(N,_) -> N.
+
+%%% ------------------------------------------------------
+%%% Check that the children start specification is valid.
+%%% Shall be a six (6) tuple
+%%% {Name, Func, RestartType, Shutdown, ChildType, Modules}
+%%% where Name is an atom
+%%% Func is {Mod, Fun, Args} == {atom, atom, list}
+%%% RestartType is permanent | temporary | transient
+%%% Shutdown = integer() | infinity | brutal_kill
+%%% ChildType = supervisor | worker
+%%% Modules = [atom()] | dynamic
+%%% Returns: {ok, [#child]} | Error
+%%% ------------------------------------------------------
+
+check_startspec(Children) -> check_startspec(Children, []).
+
+check_startspec([ChildSpec|T], Res) ->
+ case check_childspec(ChildSpec) of
+ {ok, Child} ->
+ case lists:keysearch(Child#child.name, #child.name, Res) of
+ {value, _} -> {duplicate_child_name, Child#child.name};
+ _ -> check_startspec(T, [Child | Res])
+ end;
+ Error -> Error
+ end;
+check_startspec([], Res) ->
+ {ok, lists:reverse(Res)}.
+
+check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) ->
+ catch check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods);
+check_childspec(X) -> {invalid_child_spec, X}.
+
+check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) ->
+ validName(Name),
+ validFunc(Func),
+ validRestartType(RestartType),
+ validChildType(ChildType),
+ validShutdown(Shutdown, ChildType),
+ validMods(Mods),
+ {ok, #child{name = Name, mfa = Func, restart_type = RestartType,
+ shutdown = Shutdown, child_type = ChildType, modules = Mods}}.
+
+validChildType(supervisor) -> true;
+validChildType(worker) -> true;
+validChildType(What) -> throw({invalid_child_type, What}).
+
+validName(_Name) -> true.
+
+validFunc({M, F, A}) when is_atom(M),
+ is_atom(F),
+ is_list(A) -> true;
+validFunc(Func) -> throw({invalid_mfa, Func}).
+
+validRestartType(permanent) -> true;
+validRestartType(temporary) -> true;
+validRestartType(transient) -> true;
+validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}).
+
+validShutdown(Shutdown, _)
+ when is_integer(Shutdown), Shutdown > 0 -> true;
+validShutdown(infinity, supervisor) -> true;
+validShutdown(brutal_kill, _) -> true;
+validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}).
+
+validMods(dynamic) -> true;
+validMods(Mods) when is_list(Mods) ->
+ lists:foreach(fun(Mod) ->
+ if
+ is_atom(Mod) -> ok;
+ true -> throw({invalid_module, Mod})
+ end
+ end,
+ Mods);
+validMods(Mods) -> throw({invalid_modules, Mods}).
+
+%%% ------------------------------------------------------
+%%% Add a new restart and calculate if the max restart
+%%% intensity has been reached (in that case the supervisor
+%%% shall terminate).
+%%% All restarts accured inside the period amount of seconds
+%%% are kept in the #state.restarts list.
+%%% Returns: {ok, State'} | {terminate, State'}
+%%% ------------------------------------------------------
+
+add_restart(State) ->
+ I = State#state.intensity,
+ P = State#state.period,
+ R = State#state.restarts,
+ Now = erlang:now(),
+ R1 = add_restart([Now|R], Now, P),
+ State1 = State#state{restarts = R1},
+ case length(R1) of
+ CurI when CurI =< I ->
+ {ok, State1};
+ _ ->
+ {terminate, State1}
+ end.
+
+add_restart([R|Restarts], Now, Period) ->
+ case inPeriod(R, Now, Period) of
+ true ->
+ [R|add_restart(Restarts, Now, Period)];
+ _ ->
+ []
+ end;
+add_restart([], _, _) ->
+ [].
+
+inPeriod(Time, Now, Period) ->
+ case difference(Time, Now) of
+ T when T > Period ->
+ false;
+ _ ->
+ true
+ end.
+
+%%
+%% Time = {MegaSecs, Secs, MicroSecs} (NOTE: MicroSecs is ignored)
+%% Calculate the time elapsed in seconds between two timestamps.
+%% If MegaSecs is equal just subtract Secs.
+%% Else calculate the Mega difference and add the Secs difference,
+%% note that Secs difference can be negative, e.g.
+%% {827, 999999, 676} diff {828, 1, 653753} == > 2 secs.
+%%
+difference({TimeM, TimeS, _}, {CurM, CurS, _}) when CurM > TimeM ->
+ ((CurM - TimeM) * 1000000) + (CurS - TimeS);
+difference({_, TimeS, _}, {_, CurS, _}) ->
+ CurS - TimeS.
+
+%%% ------------------------------------------------------
+%%% Error and progress reporting.
+%%% ------------------------------------------------------
+
+report_error(Error, Reason, Child, SupName) ->
+ ErrorMsg = [{supervisor, SupName},
+ {errorContext, Error},
+ {reason, Reason},
+ {offender, extract_child(Child)}],
+ error_logger:error_report(supervisor_report, ErrorMsg).
+
+
+extract_child(Child) ->
+ [{pid, Child#child.pid},
+ {name, Child#child.name},
+ {mfa, Child#child.mfa},
+ {restart_type, Child#child.restart_type},
+ {shutdown, Child#child.shutdown},
+ {child_type, Child#child.child_type}].
+
+report_progress(Child, SupName) ->
+ Progress = [{supervisor, SupName},
+ {started, extract_child(Child)}],
+ error_logger:info_report(progress, Progress).
diff --git a/patches/stdlib/sys.erl b/patches/stdlib/sys.erl
new file mode 100644
index 0000000..7256a62
--- /dev/null
+++ b/patches/stdlib/sys.erl
@@ -0,0 +1,361 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(sys).
+
+%% External exports
+-export([suspend/1, suspend/2, resume/1, resume/2,
+ get_status/1, get_status/2,
+ change_code/4, change_code/5,
+ log/2, log/3, trace/2, trace/3, statistics/2, statistics/3,
+ log_to_file/2, log_to_file/3, no_debug/1, no_debug/2,
+ install/2, install/3, remove/2, remove/3]).
+-export([reg/3, reg/4]).
+-export([handle_system_msg/6, handle_debug/4,
+ print_log/1, get_debug/3, debug_options/1]).
+
+%%-----------------------------------------------------------------
+%% System messages
+%%-----------------------------------------------------------------
+suspend(Name) -> send_system_msg(Name, suspend).
+suspend(Name, Timeout) -> send_system_msg(Name, suspend, Timeout).
+
+resume(Name) -> send_system_msg(Name, resume).
+resume(Name, Timeout) -> send_system_msg(Name, resume, Timeout).
+
+get_status(Name) -> send_system_msg(Name, get_status).
+get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout).
+
+change_code(Name, Mod, Vsn, Extra) ->
+ send_system_msg(Name, {change_code, Mod, Vsn, Extra}).
+change_code(Name, Mod, Vsn, Extra, Timeout) ->
+ send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout).
+
+reg(Name, Key, Value) ->
+ send_system_msg(Name, {reg, Key, Value}).
+reg(Name, Key, Value, Timeout) ->
+ send_system_msg(Name, {reg, Key, Value}, Timeout).
+
+%%-----------------------------------------------------------------
+%% Debug commands
+%%-----------------------------------------------------------------
+log(Name, Flag) ->
+ send_system_msg(Name, {debug, {log, Flag}}).
+log(Name, Flag, Timeout) ->
+ send_system_msg(Name, {debug, {log, Flag}}, Timeout).
+
+trace(Name, Flag) ->
+ send_system_msg(Name, {debug, {trace, Flag}}).
+trace(Name, Flag, Timeout) ->
+ send_system_msg(Name, {debug, {trace, Flag}}, Timeout).
+
+log_to_file(Name, FileName) ->
+ send_system_msg(Name, {debug, {log_to_file, FileName}}).
+log_to_file(Name, FileName, Timeout) ->
+ send_system_msg(Name, {debug, {log_to_file, FileName}}, Timeout).
+
+statistics(Name, Flag) ->
+ send_system_msg(Name, {debug, {statistics, Flag}}).
+statistics(Name, Flag, Timeout) ->
+ send_system_msg(Name, {debug, {statistics, Flag}}, Timeout).
+
+no_debug(Name) -> send_system_msg(Name, {debug, no_debug}).
+no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout).
+
+install(Name, {Func, FuncState}) ->
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}}).
+install(Name, {Func, FuncState}, Timeout) ->
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout).
+
+remove(Name, Func) ->
+ send_system_msg(Name, {debug, {remove, Func}}).
+remove(Name, Func, Timeout) ->
+ send_system_msg(Name, {debug, {remove, Func}}, Timeout).
+
+%%-----------------------------------------------------------------
+%% All system messages sent are on the form {system, From, Msg}
+%% The receiving side should send Msg to handle_system_msg/5.
+%%-----------------------------------------------------------------
+send_system_msg(Name, Request) ->
+ case catch gen:call(Name, system, Request) of
+ {ok,Res} -> Res;
+ {'EXIT', Reason} -> exit({Reason, mfa(Name, Request)})
+ end.
+
+send_system_msg(Name, Request, Timeout) ->
+ case catch gen:call(Name, system, Request, Timeout) of
+ {ok,Res} -> Res;
+ {'EXIT', Reason} -> exit({Reason, mfa(Name, Request, Timeout)})
+ end.
+
+mfa(Name, {debug, {Func, Arg2}}) ->
+ {sys, Func, [Name, Arg2]};
+mfa(Name, {change_code, Mod, Vsn, Extra}) ->
+ {sys, change_code, [Name, Mod, Vsn, Extra]};
+mfa(Name, Atom) ->
+ {sys, Atom, [Name]}.
+mfa(Name, Req, Timeout) ->
+ {M, F, A} = mfa(Name, Req),
+ {M, F, A ++ [Timeout]}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_system_msg/6
+%% Args: Msg ::= term()
+%% From ::= {pid(),Ref} but don't count on that
+%% Parent ::= pid()
+%% Module ::= atom()
+%% Debug ::= [debug_opts()]
+%% Misc ::= term()
+%% Purpose: Used by a process module that wishes to take care of
+%% system messages. The process receives a {system, From,
+%% Msg} message, and passes the Msg to this function.
+%% Returns: This function *never* returns! It calls the function
+%% Module:system_continue(Parent, NDebug, Misc)
+%% there the process continues the execution or
+%% Module:system_terminate(Raeson, Parent, Debug, Misc) if
+%% the process should terminate.
+%% The Module must export system_continue/3, system_terminate/4
+%% and format_status/2 for status information.
+%%-----------------------------------------------------------------
+handle_system_msg(Msg, From, Parent, Module, Debug, Misc) ->
+ handle_system_msg(running, Msg, From, Parent, Module, Debug, Misc).
+
+handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc) ->
+ case do_cmd(SysState, Msg, Parent, Mod, Debug, Misc) of
+ {suspended, Reply, NDebug, NMisc} ->
+ gen:reply(From, Reply),
+ suspend_loop(suspended, Parent, Mod, NDebug, NMisc);
+ {running, Reply, NDebug, NMisc} ->
+ gen:reply(From, Reply),
+ Mod:system_continue(Parent, NDebug, NMisc)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: handle_debug/4
+%% Args: Debug ::= [debug_opts()]
+%% Func ::= {M,F} | fun() arity 3
+%% State ::= term()
+%% Event ::= {in, Msg} | {in, Msg, From} | {out, Msg, To} | term()
+%% Purpose: Called by a process that wishes to debug an event.
+%% Func is a formatting function, called as Func(Device, Event).
+%% Returns: [debug_opts()]
+%%-----------------------------------------------------------------
+handle_debug([{trace, true} | T], FormFunc, State, Event) ->
+ print_event({Event, State, FormFunc}),
+ [{trace, true} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{log, {N, LogData}} | T], FormFunc, State, Event) ->
+ NLogData = [{Event, State, FormFunc} | trim(N, LogData)],
+ [{log, {N, NLogData}} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) ->
+ print_event(Fd, {Event, State, FormFunc}),
+ [{log_to_file, Fd} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{statistics, StatData} | T], FormFunc, State, Event) ->
+ NStatData = stat(Event, StatData),
+ [{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{Func, FuncState} | T], FormFunc, State, Event) ->
+ case catch Func(FuncState, Event, State) of
+ done -> handle_debug(T, FormFunc, State, Event);
+ {'EXIT', _} -> handle_debug(T, FormFunc, State, Event);
+ NFuncState ->
+ [{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)]
+ end;
+handle_debug([], _FormFunc, _State, _Event) ->
+ [].
+
+
+%%-----------------------------------------------------------------
+%% When a process is suspended, it can only respond to system
+%% messages.
+%%-----------------------------------------------------------------
+suspend_loop(SysState, Parent, Mod, Debug, Misc) ->
+ receive
+ {system, From, Msg} ->
+ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc);
+ {'EXIT', Parent, Reason} ->
+ Mod:system_terminate(Reason, Parent, Debug, Misc)
+ end.
+
+do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) ->
+ {suspended, ok, Debug, Misc};
+do_cmd(_, resume, _Parent, _Mod, Debug, Misc) ->
+ {running, ok, Debug, Misc};
+do_cmd(SysState, {reg, Key, Value}, _Parent, Mod, Debug, Misc) ->
+ Res = case erlang:function_exported(Mod, system_reg, 3) of
+ true ->
+ catch Mod:system_reg(Misc, Key, Value);
+ false ->
+ catch gproc:reg(Key, Value)
+ end,
+ {SysState, Res, Debug, Misc};
+do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) ->
+ Res = get_status(SysState, Parent, Mod, Debug, Misc),
+ {SysState, Res, Debug, Misc};
+do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) ->
+ {Res, NDebug} = debug_cmd(What, Debug),
+ {SysState, Res, NDebug, Misc};
+do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent,
+ Mod, Debug, Misc) ->
+ {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc),
+ {suspended, Res, Debug, NMisc};
+do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) ->
+ {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}.
+
+get_status(SysState, Parent, Mod, Debug, Misc) ->
+ {status, self(), {module, Mod},
+ [get(), SysState, Parent, Debug, Misc]}.
+
+%%-----------------------------------------------------------------
+%% These are the system debug commands.
+%% {trace, true|false} -> io:format
+%% {log, true|false|get|print} -> keeps the 10 last debug messages
+%% {log_to_file, FileName | false} -> io:format to file.
+%% {statistics, true|false|get} -> keeps track of messages in/out + reds.
+%%-----------------------------------------------------------------
+debug_cmd({trace, true}, Debug) ->
+ {ok, install_debug(trace, true, Debug)};
+debug_cmd({trace, false}, Debug) ->
+ {ok, remove_debug(trace, Debug)};
+debug_cmd({log, true}, Debug) ->
+ {_N, Logs} = get_debug(log, Debug, {0, []}),
+ {ok, install_debug(log, {10, trim(10, Logs)}, Debug)};
+debug_cmd({log, {true, N}}, Debug) when is_integer(N), N > 0 ->
+ {_N, Logs} = get_debug(log, Debug, {0, []}),
+ {ok, install_debug(log, {N, trim(N, Logs)}, Debug)};
+debug_cmd({log, false}, Debug) ->
+ {ok, remove_debug(log, Debug)};
+debug_cmd({log, print}, Debug) ->
+ print_log(Debug),
+ {ok, Debug};
+debug_cmd({log, get}, Debug) ->
+ {_N, Logs} = get_debug(log, Debug, {0, []}),
+ {{ok, lists:reverse(Logs)}, Debug};
+debug_cmd({log_to_file, false}, Debug) ->
+ NDebug = close_log_file(Debug),
+ {ok, NDebug};
+debug_cmd({log_to_file, FileName}, Debug) ->
+ NDebug = close_log_file(Debug),
+ case file:open(FileName, write) of
+ {ok, Fd} ->
+ {ok, install_debug(log_to_file, Fd, NDebug)};
+ _Error ->
+ {{error, open_file}, NDebug}
+ end;
+debug_cmd({statistics, true}, Debug) ->
+ {ok, install_debug(statistics, init_stat(), Debug)};
+debug_cmd({statistics, false}, Debug) ->
+ {ok, remove_debug(statistics, Debug)};
+debug_cmd({statistics, get}, Debug) ->
+ {{ok, get_stat(get_debug(statistics, Debug, []))}, Debug};
+debug_cmd(no_debug, Debug) ->
+ close_log_file(Debug),
+ {ok, []};
+debug_cmd({install, {Func, FuncState}}, Debug) ->
+ {ok, install_debug(Func, FuncState, Debug)};
+debug_cmd({remove, Func}, Debug) ->
+ {ok, remove_debug(Func, Debug)};
+debug_cmd(_Unknown, Debug) ->
+ {unknown_debug, Debug}.
+
+
+do_change_code(Mod, Module, Vsn, Extra, Misc) ->
+ case catch Mod:system_code_change(Misc, Module, Vsn, Extra) of
+ {ok, NMisc} -> {ok, NMisc};
+ Else -> {{error, Else}, Misc}
+ end.
+
+print_event(X) -> print_event(standard_io, X).
+
+print_event(Dev, {Event, State, FormFunc}) ->
+ FormFunc(Dev, Event, State).
+
+init_stat() -> {erlang:localtime(), process_info(self(), reductions), 0, 0}.
+get_stat({Time, {reductions, Reds}, In, Out}) ->
+ {reductions, Reds2} = process_info(self(), reductions),
+ [{start_time, Time}, {current_time, erlang:localtime()},
+ {reductions, Reds2 - Reds}, {messages_in, In}, {messages_out, Out}];
+get_stat(_) ->
+ no_statistics.
+
+stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
+stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
+stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
+stat(_, StatData) -> StatData.
+
+trim(N, LogData) ->
+ lists:sublist(LogData, 1, N-1).
+
+%%-----------------------------------------------------------------
+%% Debug structure manipulating functions
+%%-----------------------------------------------------------------
+install_debug(Item, Data, Debug) ->
+ case get_debug(Item, Debug, undefined) of
+ undefined -> [{Item, Data} | Debug];
+ _ -> Debug
+ end.
+remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug).
+get_debug(Item, Debug, Default) ->
+ case lists:keysearch(Item, 1, Debug) of
+ {value, {Item, Data}} -> Data;
+ _ -> Default
+ end.
+
+print_log(Debug) ->
+ {_N, Logs} = get_debug(log, Debug, {0, []}),
+ lists:foreach(fun print_event/1,
+ lists:reverse(Logs)).
+
+close_log_file(Debug) ->
+ case get_debug(log_to_file, Debug, []) of
+ [] ->
+ Debug;
+ Fd ->
+ file:close(Fd),
+ remove_debug(log_to_file, Debug)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: debug_options/1
+%% Args: [trace|log|{log,N}|statistics|{log_to_file, FileName}|
+%% {install, {Func, FuncState}}]
+%% Purpose: Initiate a debug structure. Called by a process that
+%% wishes to initiate the debug structure without the
+%% system messages.
+%% Returns: [debug_opts()]
+%%-----------------------------------------------------------------
+debug_options(Options) ->
+ debug_options(Options, []).
+debug_options([trace | T], Debug) ->
+ debug_options(T, install_debug(trace, true, Debug));
+debug_options([log | T], Debug) ->
+ debug_options(T, install_debug(log, {10, []}, Debug));
+debug_options([{log, N} | T], Debug) when is_integer(N), N > 0 ->
+ debug_options(T, install_debug(log, {N, []}, Debug));
+debug_options([statistics | T], Debug) ->
+ debug_options(T, install_debug(statistics, init_stat(), Debug));
+debug_options([{log_to_file, FileName} | T], Debug) ->
+ case file:open(FileName, write) of
+ {ok, Fd} ->
+ debug_options(T, install_debug(log_to_file, Fd, Debug));
+ _Error ->
+ debug_options(T, Debug)
+ end;
+debug_options([{install, {Func, FuncState}} | T], Debug) ->
+ debug_options(T, install_debug(Func, FuncState, Debug));
+debug_options([_ | T], Debug) ->
+ debug_options(T, Debug);
+debug_options([], Debug) ->
+ Debug.
diff --git a/src/gproc.erl b/src/gproc.erl
new file mode 100644
index 0000000..8e55177
--- /dev/null
+++ b/src/gproc.erl
@@ -0,0 +1,986 @@
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% @author Ulf Wiger
+%%
+%% @doc Extended process registry
+%%
This module implements an extended process registry
+%%
For a detailed description, see gproc/doc/erlang07-wiger.pdf.
+%% @end
+-module(gproc).
+-behaviour(gen_leader).
+
+-export([start_link/0, start_link/1,
+ reg/2, unreg/1,
+ mreg/3,
+ set_value/2,
+ get_value/1,
+ update_counter/2,
+ send/2,
+ info/1, info/2,
+ select/1, select/2,
+ first/1,
+ next/2,
+ prev/2,
+ last/1,
+ table/1, table/2]).
+
+-export([start_local/0, go_global/0, go_global/1]).
+
+%%% internal exports
+-export([init/1,
+ handle_cast/2,
+ handle_call/3,
+ handle_info/2,
+ handle_leader_call/4,
+ handle_leader_cast/3,
+ handle_DOWN/3,
+ elected/2,
+ surrendered/3,
+ from_leader/3,
+ code_change/4,
+ terminate/2]).
+
+-define(TAB, ?MODULE).
+-define(SERVER, ?MODULE).
+
+-record(state, {mode, is_leader}).
+
+start_local() ->
+ create_tabs(),
+ gen_leader:start(?SERVER, ?MODULE, [], []).
+
+go_global() ->
+ erlang:display({"calling go_global (Ns = ~p)~n", [node()|nodes()]}),
+ go_global([node()|nodes()]).
+
+go_global(Nodes) when is_list(Nodes) ->
+ erlang:display({"calling go_global(~p)~n", [node()|nodes()]}),
+ case whereis(?SERVER) of
+ undefined ->
+ start_link(Nodes);
+ Pid ->
+ link(Pid),
+ ok = call({go_global, Nodes}),
+ {ok, Pid}
+ end.
+
+start_link() ->
+ start_link([node()|nodes()]).
+
+start_link(Nodes) ->
+ create_tabs(),
+ gen_leader:start_link(
+ ?SERVER, Nodes, [],?MODULE, [], [{debug,[trace]}]).
+
+%%% @spec({Class,Scope, Key}, Value) -> true
+%%% @doc
+%%% Class = n - unique name
+%%% | p - non-unique property
+%%% | c - counter
+%%% | a - aggregated counter
+%%% Scope = l | g (global or local)
+%%%
+reg({_,g,_} = Key, Value) ->
+ %% anything global
+ leader_call({reg, Key, Value, self()});
+reg({T,l,_} = Key, Value) when T==n; T==a ->
+ %% local names and aggregated counters
+ call({reg, Key, Value});
+reg({c,l,_} = Key, Value) ->
+ %% local counter
+ if is_integer(Value) ->
+ local_reg(Key, Value);
+ true ->
+ erlang:error(badarg)
+ end;
+reg({_,l,_} = Key, Value) ->
+ %% local property
+ local_reg(Key, Value);
+reg(_, _) ->
+ erlang:error(badarg).
+
+mreg(T, g, KVL) ->
+ if is_list(KVL) -> leader_call({mreg, T, g, KVL, self()});
+ true -> erlang:error(badarg)
+ end;
+mreg(T, l, KVL) when T==a; T==n ->
+ if is_list(KVL) -> call({mreg, T, l, KVL});
+ true -> erlang:error(badarg)
+ end;
+mreg(p, l, KVL) ->
+ local_mreg(p, KVL);
+mreg(_, _, _) ->
+ erlang:error(badarg).
+
+unreg(Key) ->
+ case Key of
+ {_, g, _} -> leader_call({unreg, Key, self()});
+ {T, l, _} when T == n;
+ T == a -> call({unreg, Key});
+ {_, l, _} ->
+ case ets:member(?TAB, {Key,self()}) of
+ true ->
+ remove_reg(Key, self());
+ false ->
+ erlang:error(badarg)
+ end
+ end.
+
+select(Pat) ->
+ select(all, Pat).
+
+select(Scope, Pat) ->
+ ets:select(?TAB, pattern(Pat, Scope)).
+
+select(Scope, Pat, NObjs) ->
+ ets:select(?TAB, pattern(Pat, Scope), NObjs).
+
+
+%%% Local properties can be registered in the local process, since
+%%% no other process can interfere.
+%%%
+local_reg(Key, Value) ->
+ case insert_reg(Key, Value, self(), l) of
+ false -> erlang:error(badarg);
+ true -> monitor_me()
+ end.
+
+local_mreg(_, []) -> true;
+local_mreg(T, [_|_] = KVL) ->
+ case insert_many(T, l, KVL, self()) of
+ false -> erlang:error(badarg);
+ {true,_} -> monitor_me()
+ end.
+
+
+remove_reg(Key, Pid) ->
+ remove_reg_1(Key, Pid),
+ ets:delete(?TAB, {Pid,Key}).
+
+remove_reg_1({c,_,_} = Key, Pid) ->
+ remove_counter_1(Key, ets:lookup_element(?TAB, {Key,Pid}, 3), Pid);
+remove_reg_1({T,_,_} = Key, _Pid) when T==a; T==n ->
+ ets:delete(?TAB, {Key,T});
+remove_reg_1({_,_,_} = Key, Pid) ->
+ ets:delete(?TAB, {Key, Pid}).
+
+remove_counter_1({c,C,N} = Key, Val, Pid) ->
+ update_aggr_counter(C, N, -Val),
+ ets:delete(?TAB, {Key, Pid}).
+
+
+insert_reg({T,_,Name} = K, Value, Pid, C) when T==a; T==n ->
+ %%% We want to store names and aggregated counters with the same
+ %%% structure as properties, but at the same time, we must ensure
+ %%% that the key is unique. We replace the Pid in the key part with
+ %%% an atom. To know which Pid owns the object, we lug the Pid around
+ %%% as payload as well. This is a bit redundant, but symmetric.
+ %%%
+ case ets:insert_new(?TAB, [{{K, T}, Pid, Value}, {{Pid,K}}]) of
+ true ->
+ if T == a ->
+ Initial = scan_existing_counters(C, Name),
+ ets:insert(?TAB, {{K,a}, Pid, Initial});
+ T == c ->
+ update_aggr_counter(l, Name, Value);
+ true ->
+ true
+ end,
+ true;
+ false ->
+ false
+ end;
+insert_reg(Key, Value, Pid, _C) ->
+ %% Non-unique keys; store Pid in the key part
+ K = {Key, Pid},
+ Kr = {Pid, Key},
+ ets:insert_new(?TAB, [{K, Pid, Value}, {Kr}]).
+
+insert_many(T, C, KVL, Pid) ->
+ Objs = mk_reg_objs(T, C, Pid, KVL),
+ case ets:insert_new(?TAB, Objs) of
+ true ->
+ RevObjs = mk_reg_rev_objs(T, C, Pid, KVL),
+ ets:insert(?TAB, RevObjs),
+ {true, Objs};
+ false ->
+ false
+ end.
+
+mk_reg_objs(T, C, _, L) when T == n; T == a ->
+ lists:map(fun({K,V}) ->
+ {{{T,C,K},T}, V};
+ (_) ->
+ erlang:error(badarg)
+ end, L);
+mk_reg_objs(p = T, C, Pid, L) ->
+ lists:map(fun({K,V}) ->
+ {{{T,C,K},Pid}, V};
+ (_) ->
+ erlang:error(badarg)
+ end, L).
+
+mk_reg_rev_objs(T, C, Pid, L) ->
+ [{Pid,{T,C,K}} || {K,_} <- L].
+
+
+set_value({T,g,_} = Key, Value) when T==a; T==c ->
+ if is_integer(Value) ->
+ leader_call({set, Key, Value});
+ true ->
+ erlang:error(badarg)
+ end;
+set_value({_,g,_} = Key, Value) ->
+ leader_call({set, Key, Value, self()});
+set_value({a,l,_} = Key, Value) when is_integer(Value) ->
+ call({set, Key, Value});
+set_value({n,l,_} = Key, Value) ->
+ %% we cannot do this locally, since we have to check that the object
+ %% exists first - not an atomic update.
+ call({set, Key, Value});
+set_value({p,l,_} = Key, Value) ->
+ %% we _can_ to this locally, since there is no race condition - no
+ %% other process can update our properties.
+ case do_set_value(Key, Value, self()) of
+ true -> true;
+ false ->
+ erlang:error(badarg)
+ end;
+set_value({c,l,_} = Key, Value) when is_integer(Value) ->
+ do_set_counter_value(Key, Value, self());
+set_value(_, _) ->
+ erlang:error(badarg).
+
+
+do_set_value({T,_,_} = Key, Value, Pid) ->
+ K2 = if T==n -> T;
+ true -> Pid
+ end,
+ case ets:member(?TAB, {Key, K2}) of
+ true ->
+ ets:insert(?TAB, {{Key, K2}, Pid, Value});
+ false ->
+ false
+ end.
+
+do_set_counter_value({_,C,N} = Key, Value, Pid) ->
+ OldVal = ets:lookup_element(?TAB, {Key, Pid}, 3), % may fail with badarg
+ update_aggr_counter(C, N, Value - OldVal),
+ ets:insert(?TAB, {{Key, Pid}, Pid, Value}).
+
+
+
+
+%%% @spec (Key) -> Value
+%%% @doc Read the value stored with a key registered to the current process.
+%%%
+get_value(Key) ->
+ get_value(Key, self()).
+
+get_value({T,_,_} = Key, Pid) when is_pid(Pid) ->
+ if T==n; T==a ->
+ case ets:lookup(?TAB, {Key, T}) of
+ [{_, P, Value}] when P == Pid -> Value;
+ _ -> erlang:error(badarg)
+ end;
+ true ->
+ ets:lookup_element(?TAB, {Key, Pid}, 3)
+ end;
+get_value(_, _) ->
+ erlang:error(badarg).
+
+
+update_counter({c,l,Ctr} = Key, Incr) when is_integer(Incr) ->
+ update_aggr_counter(l, Ctr, Incr),
+ ets:update_counter(?TAB, Key, {3,Incr});
+update_counter({c,g,_} = Key, Incr) when is_integer(Incr) ->
+ leader_call({update_counter, Key, Incr, self()});
+update_counter(_, _) ->
+ erlang:error(badarg).
+
+
+update_aggr_counter(C, N, Val) ->
+ catch ets:update_counter(?TAB, {{a,C,N},a}, {3, Val}).
+
+
+
+send({T,C,_} = Key, Msg) when C==l; C==g ->
+ if T == n; T == a ->
+ case ets:lookup(?TAB, {Key, T}) of
+ [{_, Pid, _}] ->
+ Pid ! Msg;
+ [] ->
+ erlang:error(badarg)
+ end;
+ T==p; T==c ->
+ %% BUG - if the key part contains select wildcards, we may end up
+ %% sending multiple messages to the same pid
+ Head = {{Key,'$1'},'_'},
+ Pids = ets:select(?TAB, [{Head,[],['$1']}]),
+ lists:foreach(fun(Pid) ->
+ Pid ! Msg
+ end, Pids),
+ Msg;
+ true ->
+ erlang:error(badarg)
+ end;
+send(_, _) ->
+ erlang:error(badarg).
+
+
+first(Scope) ->
+ {HeadPat,_} = headpat(Scope, '_', '_', '_'),
+ case ets:select(?TAB, [{HeadPat,[],[{element,1,'$_'}]}], 1) of
+ {[First], _} ->
+ First;
+ _ ->
+ '$end_of_table'
+ end.
+
+last(Scope) ->
+ {C, T} = get_c_t(Scope),
+ C1 = if C == '_'; C == l -> m;
+ C == g -> h
+ end,
+ Beyond = {{T,C1,[]},[]},
+ step(ets:prev(?TAB, Beyond), C, T).
+
+next(Scope, K) ->
+ {C,T} = get_c_t(Scope),
+ step(ets:next(?TAB,K), C, T).
+
+prev(Scope, K) ->
+ {C, T} = get_c_t(Scope),
+ step(ets:prev(?TAB, K), C, T).
+
+step(Key, '_', '_') ->
+ case Key of
+ {{_,_,_},_} -> Key;
+ _ -> '$end_of_table'
+ end;
+step(Key, '_', T) ->
+ case Key of
+ {{T,_,_},_} -> Key;
+ _ -> '$end_of_table'
+ end;
+step(Key, C, '_') ->
+ case Key of
+ {{_, C, _}, _} -> Key;
+ _ -> '$end_of_table'
+ end;
+step(Key, C, T) ->
+ case Key of
+ {{T,C,_},_} -> Key;
+ _ -> '$end_of_table'
+ end.
+
+
+
+info(Pid) when is_pid(Pid) ->
+ Items = [?MODULE | [ I || {I,_} <- process_info(self())]],
+ [info(Pid,I) || I <- Items].
+
+info(Pid, ?MODULE) ->
+ Keys = ets:select(?TAB, [{ {{Pid,'$1'}}, [], ['$1'] }]),
+ {?MODULE, lists:zf(
+ fun(K) ->
+ try V = get_value(K, Pid),
+ {true, {K,V}}
+ catch
+ error:_ ->
+ false
+ end
+ end, Keys)};
+info(Pid, I) ->
+ process_info(Pid, I).
+
+
+
+
+%%% ==========================================================
+
+
+handle_cast({monitor_me, Pid}, S) ->
+ erlang:monitor(process, Pid),
+ {ok, S}.
+
+handle_call({go_global, Nodes}, _, S) ->
+ erlang:display({"got go_global (~p)~n", [Nodes]}),
+ case S#state.mode of
+ local ->
+ {activate, Nodes, [], ok, S#state{mode = global}};
+ global ->
+ {reply, badarg, S}
+ end;
+handle_call({reg, {_,l,_} = Key, Val}, {Pid,_}, S) ->
+ case insert_reg(Key, Val, Pid, l) of
+ false ->
+ {reply, badarg, S};
+ true ->
+ ensure_monitor(Pid),
+ {reply, true, S}
+ end;
+handle_call({unreg, {_,l,_} = Key}, {Pid,_}, S) ->
+ case ets:member(?TAB, {Pid,Key}) of
+ true ->
+ remove_reg(Key, Pid),
+ {reply, true, S};
+ false ->
+ {reply, badarg, S}
+ end;
+handle_call({mreg, T, l, L}, {Pid,_}, S) ->
+ try insert_many(T, l, L, Pid) of
+ {true,_} -> {reply, true, S};
+ false -> {reply, badarg, S}
+ catch
+ error:_ -> {reply, badarg, S}
+ end;
+handle_call({set, {_,l,_} = Key, Value}, {Pid,_}, S) ->
+ case do_set_value(Key, Value, Pid) of
+ true ->
+ {reply, true, S};
+ false ->
+ {reply, badarg, S}
+ end;
+handle_call(_, _, S) ->
+ {reply, badarg, S}.
+
+handle_info({'DOWN', _MRef, process, Pid, _}, S) ->
+ Keys = ets:select(?TAB, [{{{Pid,'$1'}}, [], ['$1']}]),
+ case lists:keymember(g, 2, Keys) of
+ true ->
+ leader_cast({pid_is_DOWN, Pid});
+ false ->
+ ok
+ end,
+ ets:select_delete(?TAB, [{{{Pid,'_'}}, [], [true]}]),
+ ets:delete(?TAB, Pid),
+ lists:foreach(fun(Key) -> remove_reg_1(Key, Pid) end, Keys),
+ {ok, S};
+handle_info(_, S) ->
+ {ok, S}.
+
+
+elected(S, _E) ->
+ Globs = ets:select(?TAB, [{{{{'_',g,'_'},'_'},'_','_'},[],['$_']}]),
+ {ok, {globals, Globs}, S#state{is_leader = true}}.
+
+surrendered(S, {globals, Globs}, _E) ->
+ %% globals from this node should be more correct in our table than
+ %% in the leader's
+ surrendered_1(Globs),
+ {ok, S#state{is_leader = false}}.
+
+
+handle_DOWN(Node, S, _E) ->
+ Head = {{{'_',g,'_'},'_'},'$1','_'},
+ Gs = [{'==', {node,'$1'},Node}],
+ Globs = ets:select(?TAB, [{Head, Gs, [{element,1,'$_'}]}]),
+ ets:select_delete(?TAB, [{Head, Gs, [true]}]),
+ {ok, [{delete, Globs}], S}.
+
+handle_leader_call(_, _, #state{mode = local} = S, _) ->
+ {reply, badarg, S};
+handle_leader_call({reg, {C,g,Name} = K, Value, Pid}, _From, S, _E) ->
+ case insert_reg(K, Value, Pid, g) of
+ false ->
+ {reply, badarg, S};
+ true ->
+ ensure_monitor(Pid),
+ Vals =
+ if C == a ->
+ ets:lookup(?TAB, {K,a});
+ C == c ->
+ case ets:lookup(?TAB, {{a,g,Name},a}) of
+ [] ->
+ ets:lookup(?TAB, {K,Pid});
+ [AC] ->
+ [AC | ets:lookup(?TAB, {K,Pid})]
+ end;
+ C == n ->
+ [{{K,n},Pid,Value}];
+ true ->
+ [{{K,Pid},Pid,Value}]
+ end,
+ {reply, true, [{insert, Vals}], S}
+ end;
+handle_leader_call({unreg, {T,g,Name} = K, Pid}, _From, S, _E) ->
+ Key = if T == n; T == a -> {K,T};
+ true -> {K, Pid}
+ end,
+ case ets:member(?TAB, Key) of
+ true ->
+ remove_reg(K, Pid),
+ if T == c ->
+ case ets:lookup(?TAB, {{a,g,Name},a}) of
+ [Aggr] ->
+ %% updated by remove_reg/2
+ {reply, true, [{delete,[{Key,Pid}]},
+ {insert, [Aggr]}], S};
+ [] ->
+ {reply, true, [{delete, [{Key, Pid}]}], S}
+ end;
+ true ->
+ {reply, true, [{delete, [{Key,Pid}]}], S}
+ end;
+ false ->
+ {reply, badarg, S}
+ end;
+handle_leader_call({mreg, T, g, L, Pid}, _From, S, _E) ->
+ if T==p; T==n ->
+ try insert_many(T, g, Pid, L) of
+ {true,Objs} -> {reply, true, [{insert,Objs}], S};
+ false -> {reply, badarg, S}
+ catch
+ error:_ -> {reply, badarg, S}
+ end;
+ true -> {reply, badarg, S}
+ end;
+handle_leader_call({set,{T,g,N} =K,V,Pid}, _From, S, _E) ->
+ if T == a ->
+ if is_integer(V) ->
+ case do_set_value(K, V, Pid) of
+ true -> {reply, true, [{insert,[{{K,T},Pid,V}]}], S};
+ false -> {reply, badarg, S}
+ end
+ end;
+ T == c ->
+ try do_set_counter_value(K, V, Pid),
+ AKey = {{a,g,N},a},
+ Aggr = ets:lookup(?TAB, AKey), % may be []
+ {reply, true, [{insert, [{{K,Pid},Pid,V} | Aggr]}], S}
+ catch
+ error:_ ->
+ {reply, badarg, S}
+ end;
+ true ->
+ case do_set_value(K, V, Pid) of
+ true ->
+ Obj = if T==n -> {{K, T}, Pid, V};
+ true -> {{K, Pid}, Pid, V}
+ end,
+ {reply, true, [{insert,[Obj]}], S};
+ false ->
+ {reply, badarg, S}
+ end
+ end;
+handle_leader_call(_, _, S, _E) ->
+ {reply, badarg, S}.
+
+handle_leader_cast(_, #state{mode = local} = S, _E) ->
+ {ok, S};
+handle_leader_cast({add_globals, Missing}, S, _E) ->
+ %% This is an audit message: a peer (non-leader) had info about granted
+ %% global resources that we didn't know of when we became leader.
+ %% This could happen due to a race condition when the old leader died.
+ ets:insert(?TAB, Missing),
+ {ok, [{insert, Missing}], S};
+handle_leader_cast({remove_globals, Globals}, S, _E) ->
+ delete_globals(Globals),
+ {ok, S};
+handle_leader_cast({pid_is_DOWN, Pid}, S, _E) ->
+ Keys = ets:select(?TAB, [{{{Pid,'$1'}},[],['$1']}]),
+ Globals = if node(Pid) =/= node() ->
+ Keys;
+ true ->
+ [K || K <- Keys, element(2,K) == g]
+ end,
+ ets:select_delete(?TAB, [{{{Pid,'_'}},[],[true]}]),
+ ets:delete(?TAB, Pid),
+ Modified =
+ lists:foldl(
+ fun({T,_,_}=K,A) when T==a;T==n -> ets:delete(?TAB, {K,T}), A;
+ ({c,_,_}=K,A) -> cleanup_counter(K, Pid, A);
+ (K,A) -> ets:delete(?TAB, {K,Pid}), A
+ end, [], Keys),
+ case [{Op,Objs} || {Op,Objs} <- [{insert,Modified},
+ {remove,Globals}], Objs =/= []] of
+ [] ->
+ {ok, S};
+ Broadcast ->
+ {ok, Broadcast, S}
+ end.
+
+code_change(_FromVsn, S, _Extra, _E) ->
+ {ok, S}.
+
+terminate(_Reason, _S) ->
+ ok.
+
+
+
+
+cleanup_counter({c,g,N}=K, Pid, Acc) ->
+ remove_reg(K,Pid),
+ case ets:lookup(?TAB, {{a,g,N},a}) of
+ [Aggr] ->
+ [Aggr|Acc];
+ [] ->
+ Acc
+ end;
+cleanup_counter(K, Pid, Acc) ->
+ remove_reg(K,Pid),
+ Acc.
+
+from_leader(Ops, S, _E) ->
+ lists:foreach(
+ fun({delete, Globals}) ->
+ delete_globals(Globals);
+ ({insert, Globals}) ->
+ ets:insert(?TAB, Globals),
+ lists:foreach(
+ fun({{{_,g,_}=Key,_}, P, _}) ->
+ ets:insert(?TAB, {{P,Key}}),
+ ensure_monitor(P)
+ end, Globals)
+ end, Ops),
+ {ok, S}.
+
+delete_globals(Globals) ->
+ lists:foreach(
+ fun({{Key,_}=K, Pid}) ->
+ ets:delete(?TAB, K),
+ ets:delete(?TAB, {{Pid, Key}})
+ end, Globals).
+
+
+
+call(Req) ->
+ case gen_leader:call(?MODULE, Req) of
+ badarg -> erlang:error(badarg, Req);
+ Reply -> Reply
+ end.
+
+cast(Msg) ->
+ gen_leader:cast(?MODULE, Msg).
+
+leader_call(Req) ->
+ case gen_leader:leader_call(?MODULE, Req) of
+ badarg -> erlang:error(badarg, Req);
+ Reply -> Reply
+ end.
+
+leader_cast(Msg) ->
+ gen_leader:leader_cast(?MODULE, Msg).
+
+
+
+create_tabs() ->
+ ets:new(?MODULE, [ordered_set, public, named_table]).
+
+init({local_only,[]}) ->
+ {ok, #state{mode = local}};
+init([]) ->
+ {ok, #state{mode = global}}.
+
+
+surrendered_1(Globs) ->
+ My_local_globs =
+ ets:select(?TAB, [{{{{'_',g,'_'},'_'},'$1', '_'},
+ [{'==', {node,'$1'}, node()}],
+ ['$_']}]),
+ %% remove all remote globals - we don't have monitors on them.
+ ets:select_delete(?TAB, [{{{{'_',g,'_'},'_'}, '$1', '_'},
+ [{'=/=', {node,'$1'}, node()}],
+ [true]}]),
+ %% insert new non-local globals, collect the leader's version of
+ %% what my globals are
+ Ldr_local_globs =
+ lists:foldl(
+ fun({{Key,_}=K, Pid, V}, Acc) when node(Pid) =/= node() ->
+ ets:insert(?TAB, [{K, Pid, V}, {{Pid,Key}}]),
+ Acc;
+ ({_, Pid, _} = Obj, Acc) when node(Pid) == node() ->
+ [Obj|Acc]
+ end, [], Globs),
+ case [{K,P,V} || {K,P,V} <- My_local_globs,
+ not(lists:keymember(K, 1, Ldr_local_globs))] of
+ [] ->
+ %% phew! We have the same picture
+ ok;
+ [_|_] = Missing ->
+ %% This is very unlikely, I think
+ leader_cast({add_globals, Missing})
+ end,
+ case [{K,P} || {K,P,_} <- Ldr_local_globs,
+ not(lists:keymember(K, 1, My_local_globs))] of
+ [] ->
+ ok;
+ [_|_] = Remove ->
+ leader_cast({remove_globals, Remove})
+ end.
+
+
+ensure_monitor(Pid) when node(Pid) == node() ->
+ case ets:insert_new(?TAB, {Pid}) of
+ false -> ok;
+ true -> erlang:monitor(process, Pid)
+ end;
+ensure_monitor(_) ->
+ true.
+
+monitor_me() ->
+ case ets:insert_new(?TAB, {self()}) of
+ false -> true;
+ true ->
+ cast({monitor_me,self()}),
+ true
+ end.
+
+
+scan_existing_counters(Ctxt, Name) ->
+ Head = {{{c,Ctxt,Name},'_'},'_','$1'},
+ Cs = ets:select(?TAB, [{Head, [], ['$1']}]),
+ lists:sum(Cs).
+
+
+
+pattern([{'_', Gs, As}], T) ->
+ {HeadPat, Vs} = headpat(T, '$1', '$2', '$3'),
+ [{HeadPat, rewrite(Gs,Vs), rewrite(As,Vs)}];
+pattern([{{A,B,C},Gs,As}], Scope) ->
+ {HeadPat, Vars} = headpat(Scope, A,B,C),
+ [{HeadPat, rewrite(Gs,Vars), rewrite(As,Vars)}];
+pattern([{Head, Gs, As}], Scope) ->
+ case is_var(Head) of
+ {true,N} ->
+ {A,B,C} = vars(N),
+ {HeadPat, Vs} = headpat(Scope, A,B,C),
+ %% the headpat function should somehow verify that Head is
+ %% consistent with Scope (or should we add a guard?)
+ [{HeadPat, rewrite(Gs, Vs), rewrite(As, Vs)}];
+ false ->
+ erlang:error(badarg)
+ end.
+
+headpat({C, T}, V1,V2,V3) when C==global; C==local; C==all ->
+ headpat(type(T), ctxt(C), V1,V2,V3);
+headpat(T, V1, V2, V3) when is_atom(T) ->
+ headpat(type(T), l, V1, V2, V3);
+headpat(_, _, _, _) -> erlang:error(badarg).
+
+headpat(T, C, V1,V2,V3) ->
+ Rf = fun(Pos) ->
+ {element,Pos,{element,1,{element,1,'$_'}}}
+ end,
+ K2 = if T==n; T==a -> T;
+ true -> '_'
+ end,
+ {Kp,Vars} = case V1 of
+ {Vt,Vc,Vn} ->
+ {T1,Vs1} = subst(T,Vt,fun() -> Rf(1) end,[]),
+ {C1,Vs2} = subst(C,Vc,fun() -> Rf(2) end,Vs1),
+ {{T1,C1,Vn}, Vs2};
+ '_' ->
+ {{T,C,'_'}, []};
+ _ ->
+ case is_var(V1) of
+ true ->
+ {{T,C,'_'}, [{V1, {element,1,
+ {element,1,'$_'}}}]};
+ false ->
+ erlang:error(badarg)
+ end
+ end,
+ {{{Kp,K2},V2,V3}, Vars}.
+
+
+subst(X, '_', _F, Vs) ->
+ {X, Vs};
+subst(X, V, F, Vs) ->
+ case is_var(V) of
+ true ->
+ {X, [{V,F()}|Vs]};
+ false ->
+ {V, Vs}
+ end.
+
+ctxt(all) -> '_';
+ctxt(global) -> g;
+ctxt(local) -> l.
+
+type(all) -> '_';
+type(names) -> n;
+type(props) -> p;
+type(counters) -> c;
+type(aggr_counters) -> a.
+
+keypat(Scope) ->
+ {C,T} = get_c_t(Scope),
+ {{T,C,'_'},'_'}.
+
+
+
+get_c_t({C,T}) -> {ctxt(C), type(T)};
+get_c_t(T) when is_atom(T) ->
+ {l, type(T)}.
+
+is_var('$1') -> true;
+is_var('$2') -> true;
+is_var('$3') -> true;
+is_var('$4') -> true;
+is_var('$5') -> true;
+is_var('$6') -> true;
+is_var('$7') -> true;
+is_var('$8') -> true;
+is_var('$9') -> true;
+is_var(X) when is_atom(X) ->
+ case atom_to_list(X) of
+ "$" ++ Tl ->
+ try N = list_to_integer(Tl),
+ {true,N}
+ catch
+ error:_ ->
+ false
+ end;
+ _ ->
+ false
+ end;
+is_var(_) -> false.
+
+vars(N) when N > 3 ->
+ {'$1','$2','$3'};
+vars(_) ->
+ {'$4','$5','$6'}.
+
+
+rewrite(Gs, R) ->
+ [rewrite1(G, R) || G <- Gs].
+
+rewrite1('$_', _) ->
+ {{ {element,1,{element,1,'$_'}},
+ {element,2,'$_'},
+ {element,3,'$_'} }};
+rewrite1('$$', _) ->
+ [ {element,1,{element,1,'$_'}},
+ {element,2,'$_'},
+ {element,3,'$_'} ];
+rewrite1(Guard, R) when is_tuple(Guard) ->
+ list_to_tuple([rewrite1(G, R) || G <- tuple_to_list(Guard)]);
+rewrite1(Exprs, R) when is_list(Exprs) ->
+ [rewrite1(E, R) || E <- Exprs];
+rewrite1(V, R) when is_atom(V) ->
+ case is_var(V) of
+ true ->
+ case lists:keysearch(V, 1, R) of
+ {value, {_, V1}} ->
+ V1;
+ false ->
+ V
+ end;
+ false ->
+ V
+ end;
+rewrite1(Expr, _) ->
+ Expr.
+
+
+table(Scope) ->
+ table(Scope, []).
+
+table(T, Opts) ->
+ [Traverse, NObjs] = [proplists:get_value(K,Opts,Def) ||
+ {K,Def} <- [{traverse,select}, {n_objects,100}]],
+ TF = case Traverse of
+ first_next ->
+ fun() -> qlc_next(T, first(T)) end;
+ last_prev -> fun() -> qlc_prev(T, last(T)) end;
+ select ->
+ fun(MS) -> qlc_select(select(T,MS,NObjs)) end;
+ {select,MS} ->
+ fun() -> qlc_select(select(T,MS,NObjs)) end;
+ _ ->
+ erlang:error(badarg, [T,Opts])
+ end,
+ InfoFun = fun(indices) -> [2];
+ (is_unique_objects) -> is_unique(T);
+ (keypos) -> 1;
+ (is_sorted_key) -> true;
+ (num_of_objects) ->
+ %% this is just a guesstimate.
+ trunc(ets:info(?TAB,size) / 2.5)
+ end,
+ LookupFun =
+ case Traverse of
+ {select, _MS} -> undefined;
+ _ -> fun(Pos, Ks) -> qlc_lookup(T, Pos, Ks) end
+ end,
+ qlc:table(TF, [{info_fun, InfoFun},
+ {lookup_fun, LookupFun}] ++ [{K,V} || {K,V} <- Opts,
+ K =/= traverse,
+ K =/= n_objects]).
+qlc_lookup(_Scope, 1, Keys) ->
+ lists:flatmap(
+ fun(Key) ->
+ ets:select(?TAB, [{ {{Key,'_'},'_','_'}, [],
+ [{{ {element,1,{element,1,'$_'}},
+ {element,2,'$_'},
+ {element,3,'$_'} }}] }])
+ end, Keys);
+qlc_lookup(Scope, 2, Pids) ->
+ lists:flatmap(fun(Pid) ->
+ Found =
+ ets:select(?TAB, [{ {{Pid,keypat(Scope)}},
+ [], ['$_']}]),
+ lists:flatmap(
+ fun({{_,{T,_,_}=K}}) ->
+ K2 = if T==n; T==a -> T;
+ true -> Pid
+ end,
+ case ets:lookup(?TAB, {K,K2}) of
+ [{{Key,_},_,Value}] ->
+ [{Key, Pid, Value}];
+ [] ->
+ []
+ end
+ end, Found)
+ end, Pids).
+
+
+qlc_next(_, '$end_of_table') -> [];
+qlc_next(Scope, K) ->
+ case ets:lookup(?TAB, K) of
+ [{{Key,_}, Pid, V}] ->
+ [{Key,Pid,V} | fun() -> qlc_next(Scope, next(Scope, K)) end];
+ [] ->
+ qlc_next(Scope, next(Scope, K))
+ end.
+
+qlc_prev(_, '$end_of_table') -> [];
+qlc_prev(Scope, K) ->
+ case ets:lookup(?TAB, K) of
+ [{{Key,_},Pid,V}] ->
+ [{Key,Pid,V} | fun() -> qlc_prev(Scope, prev(Scope, K)) end];
+ [] ->
+ qlc_prev(Scope, prev(Scope, K))
+ end.
+
+qlc_select('$end_of_table') ->
+ [];
+qlc_select({Objects, Cont}) ->
+ Objects ++ fun() -> qlc_select(ets:select(Cont)) end.
+
+
+is_unique(names) -> true;
+is_unique(aggr_counters) -> true;
+is_unique({_, names}) -> true;
+is_unique({_, aggr_counters}) -> true;
+is_unique(n) -> true;
+is_unique(a) -> true;
+is_unique({_,n}) -> true;
+is_unique({_,a}) -> true;
+is_unique(_) -> false.
+
