Home Explore Help
Sign In
n4u
/
gproc
2
0
Fork 0
Files Issues 0 Pull Requests 0 Wiki
Browse Source

restructuring

git-svn-id: http://svn.ulf.wiger.net/gproc/trunk/gproc@9 f3948e33-8234-0410-8a80-a07eae3b6c4d
uwiger 16 years ago
commit
d0bc9d2409
14 changed files with 6881 additions and 0 deletions
Unified View Show Diff Stats
  1. BIN
      doc/erlang07-wiger.doc
  2. BIN
      doc/erlang07-wiger.pdf
  3. 245 0
      doc/gproc.html
  4. 1076 0
      patches/gen_leader/gen_leader.erl
  5. 428 0
      patches/kernel/application_master.erl
  6. 110 0
      patches/kernel/kernel.app.src
  7. 306 0
      patches/kernel/kernel.erl
  8. 366 0
      patches/stdlib/gen.erl
  9. 659 0
      patches/stdlib/gen_event.erl
  10. 596 0
      patches/stdlib/gen_fsm.erl
  11. 814 0
      patches/stdlib/gen_server.erl
  12. 934 0
      patches/stdlib/supervisor.erl
  13. 361 0
      patches/stdlib/sys.erl
  14. 986 0
      src/gproc.erl

BIN
doc/erlang07-wiger.doc
View File


BIN
doc/erlang07-wiger.pdf
View File


+ 245 - 0
doc/gproc.html
View File 

@@ -0,0 +1,245 @@
 
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
 
+<html>
 
+<head>
 
+<title>Module gproc</title>
 
+<link rel="stylesheet" type="text/css" href="stylesheet.css" title="EDoc">
 
+</head>
 
+<body bgcolor="white">
 
+<div class="navbar"><a name="#navbar_top"></a><table width="100%" border="0" cellspacing="0" cellpadding="2" summary="navigation bar"><tr><td><a href="overview-summary.html" target="overviewFrame">Overview</a></td><td><a href="http://www.erlang.org/"><img src="erlang.png" align="right" border="0" alt="erlang logo"></a></td></tr></table></div>
 
+<hr>
 
+
 
+<h1>Module gproc</h1>
 
+<ul class="index"><li><a href="#description">Description</a></li><li><a href="#index">Function Index</a></li><li><a href="#functions">Function Details</a></li></ul>Extended process registry.
 
+
 
+<p><b>Behaviours:</b> <a href="gen_leader.html"><tt>gen_leader</tt></a>.</p>
 
+<p><b>Authors:</b> Ulf Wiger (<a href="mailto:ulf.wiger@ericsson.com"><tt>ulf.wiger@ericsson.com</tt></a>).</p>
 
+
 
+<h2><a name="description">Description</a></h2>Extended process registry
 
+  <p>This module implements an extended process registry</p>
 
+  <p>For a detailed description, see gproc/doc/erlang07-wiger.pdf.</p>
 
+<h2><a name="index">Function Index</a></h2>
 
+<table width="100%" border="1" cellspacing="0" cellpadding="2" summary="function index"><tr><td valign="top"><a href="#code_change-4">code_change/4</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#elected-2">elected/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#first-1">first/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#from_leader-3">from_leader/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#get_value-1">get_value/1</a></td><td>Read the value stored with a key registered to the current process.</td></tr>
 
+<tr><td valign="top"><a href="#go_global-0">go_global/0</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#go_global-1">go_global/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_DOWN-3">handle_DOWN/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_call-3">handle_call/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_cast-2">handle_cast/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_info-2">handle_info/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_leader_call-4">handle_leader_call/4</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#handle_leader_cast-3">handle_leader_cast/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#info-1">info/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#info-2">info/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#init-1">init/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#last-1">last/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#mreg-3">mreg/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#next-2">next/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#prev-2">prev/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#reg-2">reg/2</a></td><td>
 
+      Class = n  - unique name
 
+            | p  - non-unique property
 
+            | c  - counter
 
+            | a  - aggregated counter
 
+      Scope = l | g (global or local).</td></tr>
 
+<tr><td valign="top"><a href="#select-1">select/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#select-2">select/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#send-2">send/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#set_value-2">set_value/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#start_link-0">start_link/0</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#start_link-1">start_link/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#start_local-0">start_local/0</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#surrendered-3">surrendered/3</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#table-1">table/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#table-2">table/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#terminate-2">terminate/2</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#unreg-1">unreg/1</a></td><td></td></tr>
 
+<tr><td valign="top"><a href="#update_counter-2">update_counter/2</a></td><td></td></tr>
 
+</table>
 
+
 
+<h2><a name="functions">Function Details</a></h2>
 
+
 
+<h3 class="function"><a name="code_change-4">code_change/4</a></h3>
 
+<div class="spec">
 
+<p><tt>code_change(FromVsn, S, Extra, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="elected-2">elected/2</a></h3>
 
+<div class="spec">
 
+<p><tt>elected(S, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="first-1">first/1</a></h3>
 
+<div class="spec">
 
+<p><tt>first(Scope) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="from_leader-3">from_leader/3</a></h3>
 
+<div class="spec">
 
+<p><tt>from_leader(Ops, S, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="get_value-1">get_value/1</a></h3>
 
+<div class="spec">
 
+<p><tt>get_value(Key) -&gt; Value</tt></p>
 
+</div><p>Read the value stored with a key registered to the current process.
 
+  </p>
 
+
 
+<h3 class="function"><a name="go_global-0">go_global/0</a></h3>
 
+<div class="spec">
 
+<p><tt>go_global() -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="go_global-1">go_global/1</a></h3>
 
+<div class="spec">
 
+<p><tt>go_global(Nodes) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_DOWN-3">handle_DOWN/3</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_DOWN(Node, S, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_call-3">handle_call/3</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_call(X1, X2, S) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_cast-2">handle_cast/2</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_cast(X1, S) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_info-2">handle_info/2</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_info(X1, S) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_leader_call-4">handle_leader_call/4</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_leader_call(X1, From, State, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="handle_leader_cast-3">handle_leader_cast/3</a></h3>
 
+<div class="spec">
 
+<p><tt>handle_leader_cast(X1, State, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="info-1">info/1</a></h3>
 
+<div class="spec">
 
+<p><tt>info(Pid) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="info-2">info/2</a></h3>
 
+<div class="spec">
 
+<p><tt>info(Pid, I) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="init-1">init/1</a></h3>
 
+<div class="spec">
 
+<p><tt>init(X1) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="last-1">last/1</a></h3>
 
+<div class="spec">
 
+<p><tt>last(Scope) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="mreg-3">mreg/3</a></h3>
 
+<div class="spec">
 
+<p><tt>mreg(T, X2, KVL) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="next-2">next/2</a></h3>
 
+<div class="spec">
 
+<p><tt>next(Scope, K) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="prev-2">prev/2</a></h3>
 
+<div class="spec">
 
+<p><tt>prev(Scope, K) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="reg-2">reg/2</a></h3>
 
+<div class="spec">
 
+<p><tt>reg(Key, Value) -&gt; any()</tt></p>
 
+</div><p>
 
+      Class = n  - unique name
 
+            | p  - non-unique property
 
+            | c  - counter
 
+            | a  - aggregated counter
 
+      Scope = l | g (global or local)
 
+  </p>
 
+
 
+<h3 class="function"><a name="select-1">select/1</a></h3>
 
+<div class="spec">
 
+<p><tt>select(Pat) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="select-2">select/2</a></h3>
 
+<div class="spec">
 
+<p><tt>select(Scope, Pat) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="send-2">send/2</a></h3>
 
+<div class="spec">
 
+<p><tt>send(Key, Msg) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="set_value-2">set_value/2</a></h3>
 
+<div class="spec">
 
+<p><tt>set_value(Key, Value) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="start_link-0">start_link/0</a></h3>
 
+<div class="spec">
 
+<p><tt>start_link() -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="start_link-1">start_link/1</a></h3>
 
+<div class="spec">
 
+<p><tt>start_link(Nodes) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="start_local-0">start_local/0</a></h3>
 
+<div class="spec">
 
+<p><tt>start_local() -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="surrendered-3">surrendered/3</a></h3>
 
+<div class="spec">
 
+<p><tt>surrendered(S, X2, E) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="table-1">table/1</a></h3>
 
+<div class="spec">
 
+<p><tt>table(Scope) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="table-2">table/2</a></h3>
 
+<div class="spec">
 
+<p><tt>table(T, Opts) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="terminate-2">terminate/2</a></h3>
 
+<div class="spec">
 
+<p><tt>terminate(Reason, S) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="unreg-1">unreg/1</a></h3>
 
+<div class="spec">
 
+<p><tt>unreg(Key) -&gt; any()</tt></p>
 
+</div>
 
+
 
+<h3 class="function"><a name="update_counter-2">update_counter/2</a></h3>
 
+<div class="spec">
 
+<p><tt>update_counter(Key, Incr) -&gt; any()</tt></p>
 
+</div>
 
+<hr>
 
+
 
+<div class="navbar"><a name="#navbar_bottom"></a><table width="100%" border="0" cellspacing="0" cellpadding="2" summary="navigation bar"><tr><td><a href="overview-summary.html" target="overviewFrame">Overview</a></td><td><a href="http://www.erlang.org/"><img src="erlang.png" align="right" border="0" alt="erlang logo"></a></td></tr></table></div>
 
+<p><i>Generated by EDoc, Sep 4 2008, 11:29:40.</i></p>
 
+</body>
 
+</html>

+ 1076 - 0
patches/gen_leader/gen_leader.erl
View File 

@@ -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 <ulf.wiger@ericsson.com>
 
+%% @author Thomas Arts <thomas.arts@ituniv.se>
 
+%% 
+%% @doc Leader election behaviour.
 
+%% <p>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.</p>
 
+%% <p>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.</p>
 
+%% <p>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.</p>
 
+%% @end
 
+%%
 
+%% @type election() = tuple(). Opaque state of the gen_leader behaviour.
 
+%% @type node() = atom(). A node name.
 
+%% @type name() = atom(). A locally registered name.
 
+%% @type serverRef() = Name | {name(),node()} | {global,Name} | pid(). 
+%%   See gen_server.
 
+%% @type callerRef() = {pid(), reference()}. See gen_server.
 
+%%
 
+-module(gen_leader).
 
+
 
+
 
+-export([start/4, start/6,
 
+	 start_link/4, start_link/6,
 
+	 leader_call/2, leader_call/3, leader_cast/2,
 
+	 call/2, call/3, cast/2,
 
+	 reply/2]).
 
+
 
+%% Query functions
 
+-export([alive/1,
 
+	 down/1,
 
+	 candidates/1,
 
+	 workers/1]).
 
+
 
+-export([
 
+	 system_continue/3,
 
+	 system_terminate/4,
 
+	 system_code_change/4,
 
+	 format_status/2
 
+	]).
 
+
 
+-export([behaviour_info/1]).
 
+
 
+%% Internal exports
 
+-export([init_it/6, print_event/3
 
+	 %%, safe_send/2
 
+	]).
 
+
 
+-import(error_logger , [format/2]).
 
+-import(lists, [foldl/3,
 
+		foreach/2,
 
+		member/2,
 
+		keydelete/3,
 
+		keysearch/3,
 
+		keymember/3]).
 
+
 
+
 
+-record(election,{leader = none,
 
+		  mode = global,
 
+		  name,
 
+		  leadernode = none,
 
+		  candidate_nodes = [],	
+		  worker_nodes = [],
 
+		  alive = [],
 
+		  iteration,
 
+		  down = [],
 
+		  monitored = [],
 
+		  buffered = []
 
+		 }).
 
+
 
+-record(server, {parent,
 
+		 mod,
 
+		 state,
 
+		 debug}).
 
+
 
+%%% ---------------------------------------------------
 
+%%% Interface functions.
 
+%%% ---------------------------------------------------
 
+
 
+%% @hidden
 
+behaviour_info(callbacks) ->
 
+    [{init,1},
 
+     {elected,2},
 
+     {surrendered,3},
 
+     {handle_leader_call,4},
 
+     {handle_leader_cast,3},
 
+     {handle_local_only, 4},
 
+     {from_leader,3},
 
+     {handle_call,3},
 
+     {handle_cast,2},
 
+     {handle_DOWN,3},
 
+     {handle_info,2},
 
+     {terminate,2},
 
+     {code_change,4}];
 
+behaviour_info(_Other) ->
 
+    undefined.
 
+
 
+start(Name, Mod, Arg, Options) when is_atom(Name) ->
 
+    gen:start(?MODULE, nolink, {local,Name},
 
+	      Mod, {local_only, Arg}, Options).
 
+
 
+%% @spec start(Name::node(), CandidateNodes::[node()],
 
+%%             Workers::[node()], Mod::atom(), Arg, Options::list()) ->
 
+%%    {ok,pid()}
 
+%%
 
+%% @doc Starts a gen_leader process without linking to the parent.
 
+%%
 
+start(Name, [_|_] = CandidateNodes, Workers, Mod, Arg, Options)
 
+  when is_atom(Name) ->
 
+    gen:start(?MODULE, nolink, {local,Name},
 
+	      Mod, {CandidateNodes, Workers, Arg}, Options).
 
+
 
+%% @spec start_link(Name::atom(), CandidateNodes::[atom()],
 
+%%             Workers::[atom()], Mod::atom(), Arg, Options::list()) ->
 
+%%  {ok, pid()}
 
+%%
 
+%% @doc Starts a gen_leader process.
 
+%% <table>
 
+%%  <tr><td>Name</td><td>The locally registered name of the process</td></tr>
 
+%%  <tr><td>CandidateNodes</td><td>The names of nodes capable of assuming
 
+%%     a leadership role</td></tr>
 
+%%  <tr><td>Workers</td>
 
+%%     <td>The names of nodes that will be part of the "cluster",
 
+%%         but cannot ever assume a leadership role.</td></tr>
 
+%%  <tr><td>Mod</td><td>The name of the callback module</td></tr>
 
+%%  <tr><td>Arg</td><td>Argument passed on to <code>Mod:init/1</code></td></tr>
 
+%%  <tr><td>Options</td><td>Same as gen_server's Options</td></tr>
 
+%% </table>
 
+%%
 
+%% <p>The list of candidates needs to be known from the start. Workers 
+%% can be added at runtime.</p>
 
+%% @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 <code>gen_server:call/2</code>, but with a slightly
 
+%% different exit reason if something goes wrong. This function calls 
+%% the <code>gen_leader</code> 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 <code>gen_server:call/3</code>, but with a slightly
 
+%% different exit reason if something goes wrong. This function calls 
+%% the <code>gen_leader</code> 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 <code>gen_server:call/2</code>) 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.
 
+%% <p>This function uses <code>gen:call/3</code>, and is subject to the
 
+%% same default timeout as e.g. <code>gen_server:call/2</code>.</p>
 
+%% @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 <code>gen_server:call/3</code>) 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 <code>gen_server:cast/2</code> 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<Y  -> 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.
 
+

+ 428 - 0
patches/kernel/application_master.erl
View File 

@@ -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).

+ 110 - 0
patches/kernel/kernel.app.src
View File 

@@ -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, []}}
 
+ ]
 
+}.

+ 306 - 0
patches/kernel/kernel.erl
View File 

@@ -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)|
 
+%%%	          ---------------
 
+%%%                      |
 
+%%%        -------------------------------
 
+%%%       |              |                |
 
+%%%  <std services> -------------   -------------
 
+%%%   (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}.
 
+
 
+
 
+

+ 366 - 0
patches/stdlib/gen.erl
View File 

@@ -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.

+ 659 - 0
patches/stdlib/gen_event.erl
View File 

@@ -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}}].
 
+
 
+
 
+
 
+
 
+
 
+

+ 596 - 0
patches/stdlib/gen_fsm.erl
View File 

@@ -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].

+ 814 - 0
patches/stdlib/gen_server.erl
View File 

@@ -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, <ServerName>, <TimeOut>) ->_ 
+%%   
+%% 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].

+ 934 - 0
patches/stdlib/supervisor.erl
View File 

@@ -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).

+ 361 - 0
patches/stdlib/sys.erl
View File 

@@ -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.

+ 986 - 0
src/gproc.erl
View File 

@@ -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 <ulf.wiger@ericsson.com>
 
+%% 
+%% @doc Extended process registry
 
+%% <p>This module implements an extended process registry</p>
 
+%% <p>For a detailed description, see gproc/doc/erlang07-wiger.pdf.</p>
 
+%% @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.
 
+