src/gen_server2.erl
author Matthias Radestock <matthias@lshift.net>
Fri, 06 Feb 2009 14:20:11 +0000
branchbug20345
changeset 831 b95f2fd4e3f6
parent 692 0bc7488f22d8
child 924 421981ef4e8d
permissions -rw-r--r--
also prevent path expansion in rabbit-multi
     1 %% This file is a copy of gen_server.erl from the R11B-5 Erlang/OTP
     2 %% distribution, with the following modifications:
     3 %%
     4 %% 1) the module name is gen_server2
     5 %%
     6 %% 2) more efficient handling of selective receives in callbacks
     7 %% gen_server2 processes drain their message queue into an internal
     8 %% buffer before invoking any callback module functions. Messages are
     9 %% dequeued from the buffer for processing. Thus the effective message
    10 %% queue of a gen_server2 process is the concatenation of the internal
    11 %% buffer and the real message queue.
    12 %% As a result of the draining, any selective receive invoked inside a
    13 %% callback is less likely to have to scan a large message queue.
    14 %%
    15 %% 3) gen_server2:cast is guaranteed to be order-preserving
    16 %% The original code could reorder messages when communicating with a
    17 %% process on a remote node that was not currently connected.
    18 %%
    19 %% All modifications are (C) 2009 LShift Ltd.
    20 
    21 %% ``The contents of this file are subject to the Erlang Public License,
    22 %% Version 1.1, (the "License"); you may not use this file except in
    23 %% compliance with the License. You should have received a copy of the
    24 %% Erlang Public License along with this software. If not, it can be
    25 %% retrieved via the world wide web at http://www.erlang.org/.
    26 %% 
    27 %% Software distributed under the License is distributed on an "AS IS"
    28 %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
    29 %% the License for the specific language governing rights and limitations
    30 %% under the License.
    31 %% 
    32 %% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
    33 %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
    34 %% AB. All Rights Reserved.''
    35 %% 
    36 %%     $Id$
    37 %%
    38 -module(gen_server2).
    39 
    40 %%% ---------------------------------------------------
    41 %%%
    42 %%% The idea behind THIS server is that the user module
    43 %%% provides (different) functions to handle different
    44 %%% kind of inputs. 
    45 %%% If the Parent process terminates the Module:terminate/2
    46 %%% function is called.
    47 %%%
    48 %%% The user module should export:
    49 %%%
    50 %%%   init(Args)  
    51 %%%     ==> {ok, State}
    52 %%%         {ok, State, Timeout}
    53 %%%         ignore
    54 %%%         {stop, Reason}
    55 %%%
    56 %%%   handle_call(Msg, {From, Tag}, State)
    57 %%%
    58 %%%    ==> {reply, Reply, State}
    59 %%%        {reply, Reply, State, Timeout}
    60 %%%        {noreply, State}
    61 %%%        {noreply, State, Timeout}
    62 %%%        {stop, Reason, Reply, State}  
    63 %%%              Reason = normal | shutdown | Term terminate(State) is called
    64 %%%
    65 %%%   handle_cast(Msg, State)
    66 %%%
    67 %%%    ==> {noreply, State}
    68 %%%        {noreply, State, Timeout}
    69 %%%        {stop, Reason, State} 
    70 %%%              Reason = normal | shutdown | Term terminate(State) is called
    71 %%%
    72 %%%   handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ...
    73 %%%
    74 %%%    ==> {noreply, State}
    75 %%%        {noreply, State, Timeout}
    76 %%%        {stop, Reason, State} 
    77 %%%              Reason = normal | shutdown | Term, terminate(State) is called
    78 %%%
    79 %%%   terminate(Reason, State) Let the user module clean up
    80 %%%        always called when server terminates
    81 %%%
    82 %%%    ==> ok
    83 %%%
    84 %%%
    85 %%% The work flow (of the server) can be described as follows:
    86 %%%
    87 %%%   User module                          Generic
    88 %%%   -----------                          -------
    89 %%%     start            ----->             start
    90 %%%     init             <-----              .
    91 %%%
    92 %%%                                         loop
    93 %%%     handle_call      <-----              .
    94 %%%                      ----->             reply
    95 %%%
    96 %%%     handle_cast      <-----              .
    97 %%%
    98 %%%     handle_info      <-----              .
    99 %%%
   100 %%%     terminate        <-----              .
   101 %%%
   102 %%%                      ----->             reply
   103 %%%
   104 %%%
   105 %%% ---------------------------------------------------
   106 
   107 %% API
   108 -export([start/3, start/4,
   109 	 start_link/3, start_link/4,
   110 	 call/2, call/3,
   111 	 cast/2, reply/2,
   112 	 abcast/2, abcast/3,
   113 	 multi_call/2, multi_call/3, multi_call/4,
   114 	 enter_loop/3, enter_loop/4, enter_loop/5]).
   115 
   116 -export([behaviour_info/1]).
   117 
   118 %% System exports
   119 -export([system_continue/3,
   120 	 system_terminate/4,
   121 	 system_code_change/4,
   122 	 format_status/2]).
   123 
   124 %% Internal exports
   125 -export([init_it/6, print_event/3]).
   126 
   127 -import(error_logger, [format/2]).
   128 
   129 %%%=========================================================================
   130 %%%  API
   131 %%%=========================================================================
   132 
   133 behaviour_info(callbacks) ->
   134     [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},
   135      {terminate,2},{code_change,3}];
   136 behaviour_info(_Other) ->
   137     undefined.
   138 
   139 %%%  -----------------------------------------------------------------
   140 %%% Starts a generic server.
   141 %%% start(Mod, Args, Options)
   142 %%% start(Name, Mod, Args, Options)
   143 %%% start_link(Mod, Args, Options)
   144 %%% start_link(Name, Mod, Args, Options) where:
   145 %%%    Name ::= {local, atom()} | {global, atom()}
   146 %%%    Mod  ::= atom(), callback module implementing the 'real' server
   147 %%%    Args ::= term(), init arguments (to Mod:init/1)
   148 %%%    Options ::= [{timeout, Timeout} | {debug, [Flag]}]
   149 %%%      Flag ::= trace | log | {logfile, File} | statistics | debug
   150 %%%          (debug == log && statistics)
   151 %%% Returns: {ok, Pid} |
   152 %%%          {error, {already_started, Pid}} |
   153 %%%          {error, Reason}
   154 %%% -----------------------------------------------------------------
   155 start(Mod, Args, Options) ->
   156     gen:start(?MODULE, nolink, Mod, Args, Options).
   157 
   158 start(Name, Mod, Args, Options) ->
   159     gen:start(?MODULE, nolink, Name, Mod, Args, Options).
   160 
   161 start_link(Mod, Args, Options) ->
   162     gen:start(?MODULE, link, Mod, Args, Options).
   163 
   164 start_link(Name, Mod, Args, Options) ->
   165     gen:start(?MODULE, link, Name, Mod, Args, Options).
   166 
   167 
   168 %% -----------------------------------------------------------------
   169 %% Make a call to a generic server.
   170 %% If the server is located at another node, that node will
   171 %% be monitored.
   172 %% If the client is trapping exits and is linked server termination
   173 %% is handled here (? Shall we do that here (or rely on timeouts) ?).
   174 %% ----------------------------------------------------------------- 
   175 call(Name, Request) ->
   176     case catch gen:call(Name, '$gen_call', Request) of
   177 	{ok,Res} ->
   178 	    Res;
   179 	{'EXIT',Reason} ->
   180 	    exit({Reason, {?MODULE, call, [Name, Request]}})
   181     end.
   182 
   183 call(Name, Request, Timeout) ->
   184     case catch gen:call(Name, '$gen_call', Request, Timeout) of
   185 	{ok,Res} ->
   186 	    Res;
   187 	{'EXIT',Reason} ->
   188 	    exit({Reason, {?MODULE, call, [Name, Request, Timeout]}})
   189     end.
   190 
   191 %% -----------------------------------------------------------------
   192 %% Make a cast to a generic server.
   193 %% -----------------------------------------------------------------
   194 cast({global,Name}, Request) ->
   195     catch global:send(Name, cast_msg(Request)),
   196     ok;
   197 cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> 
   198     do_cast(Dest, Request);
   199 cast(Dest, Request) when is_atom(Dest) ->
   200     do_cast(Dest, Request);
   201 cast(Dest, Request) when is_pid(Dest) ->
   202     do_cast(Dest, Request).
   203 
   204 do_cast(Dest, Request) -> 
   205     do_send(Dest, cast_msg(Request)),
   206     ok.
   207     
   208 cast_msg(Request) -> {'$gen_cast',Request}.
   209 
   210 %% -----------------------------------------------------------------
   211 %% Send a reply to the client.
   212 %% -----------------------------------------------------------------
   213 reply({To, Tag}, Reply) ->
   214     catch To ! {Tag, Reply}.
   215 
   216 %% ----------------------------------------------------------------- 
   217 %% Asyncronous broadcast, returns nothing, it's just send'n prey
   218 %%-----------------------------------------------------------------  
   219 abcast(Name, Request) when is_atom(Name) ->
   220     do_abcast([node() | nodes()], Name, cast_msg(Request)).
   221 
   222 abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) ->
   223     do_abcast(Nodes, Name, cast_msg(Request)).
   224 
   225 do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) ->
   226     do_send({Name,Node},Msg),
   227     do_abcast(Nodes, Name, Msg);
   228 do_abcast([], _,_) -> abcast.
   229 
   230 %%% -----------------------------------------------------------------
   231 %%% Make a call to servers at several nodes.
   232 %%% Returns: {[Replies],[BadNodes]}
   233 %%% A Timeout can be given
   234 %%% 
   235 %%% A middleman process is used in case late answers arrives after
   236 %%% the timeout. If they would be allowed to glog the callers message
   237 %%% queue, it would probably become confused. Late answers will 
   238 %%% now arrive to the terminated middleman and so be discarded.
   239 %%% -----------------------------------------------------------------
   240 multi_call(Name, Req)
   241   when is_atom(Name) ->
   242     do_multi_call([node() | nodes()], Name, Req, infinity).
   243 
   244 multi_call(Nodes, Name, Req) 
   245   when is_list(Nodes), is_atom(Name) ->
   246     do_multi_call(Nodes, Name, Req, infinity).
   247 
   248 multi_call(Nodes, Name, Req, infinity) ->
   249     do_multi_call(Nodes, Name, Req, infinity);
   250 multi_call(Nodes, Name, Req, Timeout) 
   251   when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
   252     do_multi_call(Nodes, Name, Req, Timeout).
   253 
   254 
   255 %%-----------------------------------------------------------------
   256 %% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>) ->_ 
   257 %%   
   258 %% Description: Makes an existing process into a gen_server. 
   259 %%              The calling process will enter the gen_server receive 
   260 %%              loop and become a gen_server process.
   261 %%              The process *must* have been started using one of the 
   262 %%              start functions in proc_lib, see proc_lib(3). 
   263 %%              The user is responsible for any initialization of the 
   264 %%              process, including registering a name for it.
   265 %%-----------------------------------------------------------------
   266 enter_loop(Mod, Options, State) ->
   267     enter_loop(Mod, Options, State, self(), infinity).
   268 
   269 enter_loop(Mod, Options, State, ServerName = {_, _}) ->
   270     enter_loop(Mod, Options, State, ServerName, infinity);
   271 
   272 enter_loop(Mod, Options, State, Timeout) ->
   273     enter_loop(Mod, Options, State, self(), Timeout).
   274 
   275 enter_loop(Mod, Options, State, ServerName, Timeout) ->
   276     Name = get_proc_name(ServerName),
   277     Parent = get_parent(),
   278     Debug = debug_options(Name, Options),
   279     Queue = queue:new(),
   280     loop(Parent, Name, State, Mod, Timeout, Queue, Debug).
   281 
   282 %%%========================================================================
   283 %%% Gen-callback functions
   284 %%%========================================================================
   285 
   286 %%% ---------------------------------------------------
   287 %%% Initiate the new process.
   288 %%% Register the name using the Rfunc function
   289 %%% Calls the Mod:init/Args function.
   290 %%% Finally an acknowledge is sent to Parent and the main
   291 %%% loop is entered.
   292 %%% ---------------------------------------------------
   293 init_it(Starter, self, Name, Mod, Args, Options) ->
   294     init_it(Starter, self(), Name, Mod, Args, Options);
   295 init_it(Starter, Parent, Name, Mod, Args, Options) ->
   296     Debug = debug_options(Name, Options),
   297     Queue = queue:new(),
   298     case catch Mod:init(Args) of
   299 	{ok, State} ->
   300 	    proc_lib:init_ack(Starter, {ok, self()}), 	    
   301 	    loop(Parent, Name, State, Mod, infinity, Queue, Debug);
   302 	{ok, State, Timeout} ->
   303 	    proc_lib:init_ack(Starter, {ok, self()}), 	    
   304 	    loop(Parent, Name, State, Mod, Timeout, Queue, Debug);
   305 	{stop, Reason} ->
   306 	    proc_lib:init_ack(Starter, {error, Reason}),
   307 	    exit(Reason);
   308 	ignore ->
   309 	    proc_lib:init_ack(Starter, ignore),
   310 	    exit(normal);
   311 	{'EXIT', Reason} ->
   312 	    proc_lib:init_ack(Starter, {error, Reason}),
   313 	    exit(Reason);
   314 	Else ->
   315 	    Error = {bad_return_value, Else},
   316 	    proc_lib:init_ack(Starter, {error, Error}),
   317 	    exit(Error)
   318     end.
   319 
   320 %%%========================================================================
   321 %%% Internal functions
   322 %%%========================================================================
   323 %%% ---------------------------------------------------
   324 %%% The MAIN loop.
   325 %%% ---------------------------------------------------
   326 loop(Parent, Name, State, Mod, Time, Queue, Debug) ->
   327     receive
   328         Input -> loop(Parent, Name, State, Mod,
   329                       Time, queue:in(Input, Queue), Debug)
   330     after 0 ->
   331             case queue:out(Queue) of
   332                 {{value, Msg}, Queue1} ->
   333                     process_msg(Parent, Name, State, Mod,
   334                                 Time, Queue1, Debug, Msg);
   335                 {empty, Queue1} ->
   336                     receive
   337                         Input ->
   338                             loop(Parent, Name, State, Mod,
   339                                  Time, queue:in(Input, Queue1), Debug)
   340                     after Time ->
   341                             process_msg(Parent, Name, State, Mod,
   342                                         Time, Queue1, Debug, timeout)
   343                     end
   344             end
   345     end.
   346                     
   347 process_msg(Parent, Name, State, Mod, Time, Queue, Debug, Msg) ->
   348     case Msg of
   349 	{system, From, Req} ->
   350 	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
   351 				  [Name, State, Mod, Time, Queue]);
   352 	{'EXIT', Parent, Reason} ->
   353 	    terminate(Reason, Name, Msg, Mod, State, Debug);
   354 	_Msg when Debug =:= [] ->
   355 	    handle_msg(Msg, Parent, Name, State, Mod, Time, Queue);
   356 	_Msg ->
   357 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, 
   358 				      Name, {in, Msg}),
   359 	    handle_msg(Msg, Parent, Name, State, Mod, Time, Queue, Debug1)
   360     end.
   361 
   362 %%% ---------------------------------------------------
   363 %%% Send/recive functions
   364 %%% ---------------------------------------------------
   365 do_send(Dest, Msg) ->
   366     catch erlang:send(Dest, Msg).
   367 
   368 do_multi_call(Nodes, Name, Req, infinity) ->
   369     Tag = make_ref(),
   370     Monitors = send_nodes(Nodes, Name, Tag, Req),
   371     rec_nodes(Tag, Monitors, Name, undefined);
   372 do_multi_call(Nodes, Name, Req, Timeout) ->
   373     Tag = make_ref(),
   374     Caller = self(),
   375     Receiver =
   376 	spawn(
   377 	  fun() ->
   378 		  %% Middleman process. Should be unsensitive to regular
   379 		  %% exit signals. The sychronization is needed in case
   380 		  %% the receiver would exit before the caller started
   381 		  %% the monitor.
   382 		  process_flag(trap_exit, true),
   383 		  Mref = erlang:monitor(process, Caller),
   384 		  receive
   385 		      {Caller,Tag} ->
   386 			  Monitors = send_nodes(Nodes, Name, Tag, Req),
   387 			  TimerId = erlang:start_timer(Timeout, self(), ok),
   388 			  Result = rec_nodes(Tag, Monitors, Name, TimerId),
   389 			  exit({self(),Tag,Result});
   390 		      {'DOWN',Mref,_,_,_} ->
   391 			  %% Caller died before sending us the go-ahead.
   392 			  %% Give up silently.
   393 			  exit(normal)
   394 		  end
   395 	  end),
   396     Mref = erlang:monitor(process, Receiver),
   397     Receiver ! {self(),Tag},
   398     receive
   399 	{'DOWN',Mref,_,_,{Receiver,Tag,Result}} ->
   400 	    Result;
   401 	{'DOWN',Mref,_,_,Reason} ->
   402 	    %% The middleman code failed. Or someone did 
   403 	    %% exit(_, kill) on the middleman process => Reason==killed
   404 	    exit(Reason)
   405     end.
   406 
   407 send_nodes(Nodes, Name, Tag, Req) ->
   408     send_nodes(Nodes, Name, Tag, Req, []).
   409 
   410 send_nodes([Node|Tail], Name, Tag, Req, Monitors)
   411   when is_atom(Node) ->
   412     Monitor = start_monitor(Node, Name),
   413     %% Handle non-existing names in rec_nodes.
   414     catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req},
   415     send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]);
   416 send_nodes([_Node|Tail], Name, Tag, Req, Monitors) ->
   417     %% Skip non-atom Node
   418     send_nodes(Tail, Name, Tag, Req, Monitors);
   419 send_nodes([], _Name, _Tag, _Req, Monitors) -> 
   420     Monitors.
   421 
   422 %% Against old nodes:
   423 %% If no reply has been delivered within 2 secs. (per node) check that
   424 %% the server really exists and wait for ever for the answer.
   425 %%
   426 %% Against contemporary nodes:
   427 %% Wait for reply, server 'DOWN', or timeout from TimerId.
   428 
   429 rec_nodes(Tag, Nodes, Name, TimerId) -> 
   430     rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId).
   431 
   432 rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) ->
   433     receive
   434 	{'DOWN', R, _, _, _} ->
   435 	    rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId);
   436 	{{Tag, N}, Reply} ->  %% Tag is bound !!!
   437 	    unmonitor(R), 
   438 	    rec_nodes(Tag, Tail, Name, Badnodes, 
   439 		      [{N,Reply}|Replies], Time, TimerId);
   440 	{timeout, TimerId, _} ->	
   441 	    unmonitor(R),
   442 	    %% Collect all replies that already have arrived
   443 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   444     end;
   445 rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) ->
   446     %% R6 node
   447     receive
   448 	{nodedown, N} ->
   449 	    monitor_node(N, false),
   450 	    rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId);
   451 	{{Tag, N}, Reply} ->  %% Tag is bound !!!
   452 	    receive {nodedown, N} -> ok after 0 -> ok end,
   453 	    monitor_node(N, false),
   454 	    rec_nodes(Tag, Tail, Name, Badnodes,
   455 		      [{N,Reply}|Replies], 2000, TimerId);
   456 	{timeout, TimerId, _} ->	
   457 	    receive {nodedown, N} -> ok after 0 -> ok end,
   458 	    monitor_node(N, false),
   459 	    %% Collect all replies that already have arrived
   460 	    rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies)
   461     after Time ->
   462 	    case rpc:call(N, erlang, whereis, [Name]) of
   463 		Pid when is_pid(Pid) -> % It exists try again.
   464 		    rec_nodes(Tag, [N|Tail], Name, Badnodes,
   465 			      Replies, infinity, TimerId);
   466 		_ -> % badnode
   467 		    receive {nodedown, N} -> ok after 0 -> ok end,
   468 		    monitor_node(N, false),
   469 		    rec_nodes(Tag, Tail, Name, [N|Badnodes],
   470 			      Replies, 2000, TimerId)
   471 	    end
   472     end;
   473 rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) ->
   474     case catch erlang:cancel_timer(TimerId) of
   475 	false ->  % It has already sent it's message
   476 	    receive
   477 		{timeout, TimerId, _} -> ok
   478 	    after 0 ->
   479 		    ok
   480 	    end;
   481 	_ -> % Timer was cancelled, or TimerId was 'undefined'
   482 	    ok
   483     end,
   484     {Replies, Badnodes}.
   485 
   486 %% Collect all replies that already have arrived
   487 rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) ->
   488     receive
   489 	{'DOWN', R, _, _, _} ->
   490 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
   491 	{{Tag, N}, Reply} -> %% Tag is bound !!!
   492 	    unmonitor(R),
   493 	    rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
   494     after 0 ->
   495 	    unmonitor(R),
   496 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   497     end;
   498 rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) ->
   499     %% R6 node
   500     receive
   501 	{nodedown, N} ->
   502 	    monitor_node(N, false),
   503 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
   504 	{{Tag, N}, Reply} ->  %% Tag is bound !!!
   505 	    receive {nodedown, N} -> ok after 0 -> ok end,
   506 	    monitor_node(N, false),
   507 	    rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
   508     after 0 ->
   509 	    receive {nodedown, N} -> ok after 0 -> ok end,
   510 	    monitor_node(N, false),
   511 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   512     end;
   513 rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) ->
   514     {Replies, Badnodes}.
   515 
   516 
   517 %%% ---------------------------------------------------
   518 %%% Monitor functions
   519 %%% ---------------------------------------------------
   520 
   521 start_monitor(Node, Name) when is_atom(Node), is_atom(Name) ->
   522     if node() =:= nonode@nohost, Node =/= nonode@nohost ->
   523 	    Ref = make_ref(),
   524 	    self() ! {'DOWN', Ref, process, {Name, Node}, noconnection},
   525 	    {Node, Ref};
   526        true ->
   527 	    case catch erlang:monitor(process, {Name, Node}) of
   528 		{'EXIT', _} ->
   529 		    %% Remote node is R6
   530 		    monitor_node(Node, true),
   531 		    Node;
   532 		Ref when is_reference(Ref) ->
   533 		    {Node, Ref}
   534 	    end
   535     end.
   536 
   537 %% Cancels a monitor started with Ref=erlang:monitor(_, _).
   538 unmonitor(Ref) when is_reference(Ref) ->
   539     erlang:demonitor(Ref),
   540     receive
   541 	{'DOWN', Ref, _, _, _} ->
   542 	    true
   543     after 0 ->
   544 	    true
   545     end.
   546 
   547 %%% ---------------------------------------------------
   548 %%% Message handling functions
   549 %%% ---------------------------------------------------
   550 
   551 dispatch({'$gen_cast', Msg}, Mod, State) ->
   552     Mod:handle_cast(Msg, State);
   553 dispatch(Info, Mod, State) ->
   554     Mod:handle_info(Info, State).
   555 
   556 handle_msg({'$gen_call', From, Msg},
   557            Parent, Name, State, Mod, _Time, Queue) ->
   558     case catch Mod:handle_call(Msg, From, State) of
   559 	{reply, Reply, NState} ->
   560 	    reply(From, Reply),
   561 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);
   562 	{reply, Reply, NState, Time1} ->
   563 	    reply(From, Reply),
   564 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);
   565 	{noreply, NState} ->
   566 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);
   567 	{noreply, NState, Time1} ->
   568 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);
   569 	{stop, Reason, Reply, NState} ->
   570 	    {'EXIT', R} = 
   571 		(catch terminate(Reason, Name, Msg, Mod, NState, [])),
   572 	    reply(From, Reply),
   573 	    exit(R);
   574 	Other -> handle_common_reply(Other,
   575                                      Parent, Name, Msg, Mod, State, Queue)
   576     end;
   577 handle_msg(Msg,
   578            Parent, Name, State, Mod, _Time, Queue) ->
   579     Reply = (catch dispatch(Msg, Mod, State)),
   580     handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue).
   581 
   582 handle_msg({'$gen_call', From, Msg},
   583            Parent, Name, State, Mod, _Time, Queue, Debug) ->
   584     case catch Mod:handle_call(Msg, From, State) of
   585 	{reply, Reply, NState} ->
   586 	    Debug1 = reply(Name, From, Reply, NState, Debug),
   587 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);
   588 	{reply, Reply, NState, Time1} ->
   589 	    Debug1 = reply(Name, From, Reply, NState, Debug),
   590 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);
   591 	{noreply, NState} ->
   592 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
   593 				      {noreply, NState}),
   594 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);
   595 	{noreply, NState, Time1} ->
   596 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
   597 				      {noreply, NState}),
   598 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);
   599 	{stop, Reason, Reply, NState} ->
   600 	    {'EXIT', R} = 
   601 		(catch terminate(Reason, Name, Msg, Mod, NState, Debug)),
   602 	    reply(Name, From, Reply, NState, Debug),
   603 	    exit(R);
   604 	Other ->
   605 	    handle_common_reply(Other,
   606                                 Parent, Name, Msg, Mod, State, Queue, Debug)
   607     end;
   608 handle_msg(Msg,
   609            Parent, Name, State, Mod, _Time, Queue, Debug) ->
   610     Reply = (catch dispatch(Msg, Mod, State)),
   611     handle_common_reply(Reply,
   612                         Parent, Name, Msg, Mod, State, Queue, Debug).
   613 
   614 handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue) ->
   615     case Reply of
   616 	{noreply, NState} ->
   617 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);
   618 	{noreply, NState, Time1} ->
   619 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);
   620 	{stop, Reason, NState} ->
   621 	    terminate(Reason, Name, Msg, Mod, NState, []);
   622 	{'EXIT', What} ->
   623 	    terminate(What, Name, Msg, Mod, State, []);
   624 	_ ->
   625 	    terminate({bad_return_value, Reply}, Name, Msg, Mod, State, [])
   626     end.
   627 
   628 handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue, Debug) ->
   629     case Reply of
   630 	{noreply, NState} ->
   631 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
   632 				      {noreply, NState}),
   633 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);
   634 	{noreply, NState, Time1} ->
   635 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,
   636 				      {noreply, NState}),
   637 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);
   638 	{stop, Reason, NState} ->
   639 	    terminate(Reason, Name, Msg, Mod, NState, Debug);
   640 	{'EXIT', What} ->
   641 	    terminate(What, Name, Msg, Mod, State, Debug);
   642 	_ ->
   643 	    terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug)
   644     end.
   645 
   646 reply(Name, {To, Tag}, Reply, State, Debug) ->
   647     reply({To, Tag}, Reply),
   648     sys:handle_debug(Debug, {?MODULE, print_event}, Name, 
   649 		     {out, Reply, To, State} ).
   650 
   651 
   652 %%-----------------------------------------------------------------
   653 %% Callback functions for system messages handling.
   654 %%-----------------------------------------------------------------
   655 system_continue(Parent, Debug, [Name, State, Mod, Time, Queue]) ->
   656     loop(Parent, Name, State, Mod, Time, Queue, Debug).
   657 
   658 system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time, _Queue]) ->
   659     terminate(Reason, Name, [], Mod, State, Debug).
   660 
   661 system_code_change([Name, State, Mod, Time, Queue], _Module, OldVsn, Extra) ->
   662     case catch Mod:code_change(OldVsn, State, Extra) of
   663 	{ok, NewState} -> {ok, [Name, NewState, Mod, Time, Queue]};
   664 	Else -> Else
   665     end.
   666 
   667 %%-----------------------------------------------------------------
   668 %% Format debug messages.  Print them as the call-back module sees
   669 %% them, not as the real erlang messages.  Use trace for that.
   670 %%-----------------------------------------------------------------
   671 print_event(Dev, {in, Msg}, Name) ->
   672     case Msg of
   673 	{'$gen_call', {From, _Tag}, Call} ->
   674 	    io:format(Dev, "*DBG* ~p got call ~p from ~w~n",
   675 		      [Name, Call, From]);
   676 	{'$gen_cast', Cast} ->
   677 	    io:format(Dev, "*DBG* ~p got cast ~p~n",
   678 		      [Name, Cast]);
   679 	_ ->
   680 	    io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
   681     end;
   682 print_event(Dev, {out, Msg, To, State}, Name) ->
   683     io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", 
   684 	      [Name, Msg, To, State]);
   685 print_event(Dev, {noreply, State}, Name) ->
   686     io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);
   687 print_event(Dev, Event, Name) ->
   688     io:format(Dev, "*DBG* ~p dbg  ~p~n", [Name, Event]).
   689 
   690 
   691 %%% ---------------------------------------------------
   692 %%% Terminate the server.
   693 %%% ---------------------------------------------------
   694 
   695 terminate(Reason, Name, Msg, Mod, State, Debug) ->
   696     case catch Mod:terminate(Reason, State) of
   697 	{'EXIT', R} ->
   698 	    error_info(R, Name, Msg, State, Debug),
   699 	    exit(R);
   700 	_ ->
   701 	    case Reason of
   702 		normal ->
   703 		    exit(normal);
   704 		shutdown ->
   705 		    exit(shutdown);
   706 		_ ->
   707 		    error_info(Reason, Name, Msg, State, Debug),
   708 		    exit(Reason)
   709 	    end
   710     end.
   711 
   712 error_info(_Reason, application_controller, _Msg, _State, _Debug) ->
   713     %% OTP-5811 Don't send an error report if it's the system process
   714     %% application_controller which is terminating - let init take care
   715     %% of it instead
   716     ok;
   717 error_info(Reason, Name, Msg, State, Debug) ->
   718     Reason1 = 
   719 	case Reason of
   720 	    {undef,[{M,F,A}|MFAs]} ->
   721 		case code:is_loaded(M) of
   722 		    false ->
   723 			{'module could not be loaded',[{M,F,A}|MFAs]};
   724 		    _ ->
   725 			case erlang:function_exported(M, F, length(A)) of
   726 			    true ->
   727 				Reason;
   728 			    false ->
   729 				{'function not exported',[{M,F,A}|MFAs]}
   730 			end
   731 		end;
   732 	    _ ->
   733 		Reason
   734 	end,    
   735     format("** Generic server ~p terminating \n"
   736            "** Last message in was ~p~n"
   737            "** When Server state == ~p~n"
   738            "** Reason for termination == ~n** ~p~n",
   739 	   [Name, Msg, State, Reason1]),
   740     sys:print_log(Debug),
   741     ok.
   742 
   743 %%% ---------------------------------------------------
   744 %%% Misc. functions.
   745 %%% ---------------------------------------------------
   746 
   747 opt(Op, [{Op, Value}|_]) ->
   748     {ok, Value};
   749 opt(Op, [_|Options]) ->
   750     opt(Op, Options);
   751 opt(_, []) ->
   752     false.
   753 
   754 debug_options(Name, Opts) ->
   755     case opt(debug, Opts) of
   756 	{ok, Options} -> dbg_options(Name, Options);
   757 	_ -> dbg_options(Name, [])
   758     end.
   759 
   760 dbg_options(Name, []) ->
   761     Opts = 
   762 	case init:get_argument(generic_debug) of
   763 	    error ->
   764 		[];
   765 	    _ ->
   766 		[log, statistics]
   767 	end,
   768     dbg_opts(Name, Opts);
   769 dbg_options(Name, Opts) ->
   770     dbg_opts(Name, Opts).
   771 
   772 dbg_opts(Name, Opts) ->
   773     case catch sys:debug_options(Opts) of
   774 	{'EXIT',_} ->
   775 	    format("~p: ignoring erroneous debug options - ~p~n",
   776 		   [Name, Opts]),
   777 	    [];
   778 	Dbg ->
   779 	    Dbg
   780     end.
   781 
   782 get_proc_name(Pid) when is_pid(Pid) ->
   783     Pid;
   784 get_proc_name({local, Name}) ->
   785     case process_info(self(), registered_name) of
   786 	{registered_name, Name} ->
   787 	    Name;
   788 	{registered_name, _Name} ->
   789 	    exit(process_not_registered);
   790 	[] ->
   791 	    exit(process_not_registered)
   792     end;    
   793 get_proc_name({global, Name}) ->
   794     case global:safe_whereis_name(Name) of
   795 	undefined ->
   796 	    exit(process_not_registered_globally);
   797 	Pid when Pid =:= self() ->
   798 	    Name;
   799 	_Pid ->
   800 	    exit(process_not_registered_globally)
   801     end.
   802 
   803 get_parent() ->
   804     case get('$ancestors') of
   805 	[Parent | _] when is_pid(Parent)->
   806             Parent;
   807         [Parent | _] when is_atom(Parent)->
   808             name_to_pid(Parent);
   809 	_ ->
   810 	    exit(process_was_not_started_by_proc_lib)
   811     end.
   812 
   813 name_to_pid(Name) ->
   814     case whereis(Name) of
   815 	undefined ->
   816 	    case global:safe_whereis_name(Name) of
   817 		undefined ->
   818 		    exit(could_not_find_registerd_name);
   819 		Pid ->
   820 		    Pid
   821 	    end;
   822 	Pid ->
   823 	    Pid
   824     end.
   825 
   826 %%-----------------------------------------------------------------
   827 %% Status information
   828 %%-----------------------------------------------------------------
   829 format_status(Opt, StatusData) ->
   830     [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time, Queue]] =
   831         StatusData,
   832     NameTag = if is_pid(Name) ->
   833 		      pid_to_list(Name);
   834 		 is_atom(Name) ->
   835 		      Name
   836 	      end,
   837     Header = lists:concat(["Status for generic server ", NameTag]),
   838     Log = sys:get_debug(log, Debug, []),
   839     Specfic = 
   840 	case erlang:function_exported(Mod, format_status, 2) of
   841 	    true ->
   842 		case catch Mod:format_status(Opt, [PDict, State]) of
   843 		    {'EXIT', _} -> [{data, [{"State", State}]}];
   844 		    Else -> Else
   845 		end;
   846 	    _ ->
   847 		[{data, [{"State", State}]}]
   848 	end,
   849     [{header, Header},
   850      {data, [{"Status", SysState},
   851 	     {"Parent", Parent},
   852 	     {"Logged events", Log},
   853              {"Queued messages", queue:to_list(Queue)}]} |
   854      Specfic].