src/gen_server2.erl
author Simon MacMullen <simon@rabbitmq.com>
Fri, 31 Oct 2014 16:19:51 +0000
changeset 14096 3c8a75b2c32a
parent 12959 d788449efc94
permissions -rw-r--r--
Merge bug26444
     1 %% This file is a copy of gen_server.erl from the R13B-1 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 %% 4) The callback module can optionally implement prioritise_call/4,
    20 %% prioritise_cast/3 and prioritise_info/3.  These functions take
    21 %% Message, From, Length and State or just Message, Length and State
    22 %% (where Length is the current number of messages waiting to be
    23 %% processed) and return a single integer representing the priority
    24 %% attached to the message, or 'drop' to ignore it (for
    25 %% prioritise_cast/3 and prioritise_info/3 only).  Messages with
    26 %% higher priorities are processed before requests with lower
    27 %% priorities. The default priority is 0.
    28 %%
    29 %% 5) The callback module can optionally implement
    30 %% handle_pre_hibernate/1 and handle_post_hibernate/1. These will be
    31 %% called immediately prior to and post hibernation, respectively. If
    32 %% handle_pre_hibernate returns {hibernate, NewState} then the process
    33 %% will hibernate. If the module does not implement
    34 %% handle_pre_hibernate/1 then the default action is to hibernate.
    35 %%
    36 %% 6) init can return a 4th arg, {backoff, InitialTimeout,
    37 %% MinimumTimeout, DesiredHibernatePeriod} (all in milliseconds,
    38 %% 'infinity' does not make sense here). Then, on all callbacks which
    39 %% can return a timeout (including init), timeout can be
    40 %% 'hibernate'. When this is the case, the current timeout value will
    41 %% be used (initially, the InitialTimeout supplied from init). After
    42 %% this timeout has occurred, hibernation will occur as normal. Upon
    43 %% awaking, a new current timeout value will be calculated.
    44 %%
    45 %% The purpose is that the gen_server2 takes care of adjusting the
    46 %% current timeout value such that the process will increase the
    47 %% timeout value repeatedly if it is unable to sleep for the
    48 %% DesiredHibernatePeriod. If it is able to sleep for the
    49 %% DesiredHibernatePeriod it will decrease the current timeout down to
    50 %% the MinimumTimeout, so that the process is put to sleep sooner (and
    51 %% hopefully stays asleep for longer). In short, should a process
    52 %% using this receive a burst of messages, it should not hibernate
    53 %% between those messages, but as the messages become less frequent,
    54 %% the process will not only hibernate, it will do so sooner after
    55 %% each message.
    56 %%
    57 %% When using this backoff mechanism, normal timeout values (i.e. not
    58 %% 'hibernate') can still be used, and if they are used then the
    59 %% handle_info(timeout, State) will be called as normal. In this case,
    60 %% returning 'hibernate' from handle_info(timeout, State) will not
    61 %% hibernate the process immediately, as it would if backoff wasn't
    62 %% being used. Instead it'll wait for the current timeout as described
    63 %% above.
    64 %%
    65 %% 7) The callback module can return from any of the handle_*
    66 %% functions, a {become, Module, State} triple, or a {become, Module,
    67 %% State, Timeout} quadruple. This allows the gen_server to
    68 %% dynamically change the callback module. The State is the new state
    69 %% which will be passed into any of the callback functions in the new
    70 %% module. Note there is no form also encompassing a reply, thus if
    71 %% you wish to reply in handle_call/3 and change the callback module,
    72 %% you need to use gen_server2:reply/2 to issue the reply
    73 %% manually. The init function can similarly return a 5th argument,
    74 %% Module, in order to dynamically decide the callback module on init.
    75 %%
    76 %% 8) The callback module can optionally implement
    77 %% format_message_queue/2 which is the equivalent of format_status/2
    78 %% but where the second argument is specifically the priority_queue
    79 %% which contains the prioritised message_queue.
    80 %%
    81 %% 9) The function with_state/2 can be used to debug a process with
    82 %% heavyweight state (without needing to copy the entire state out of
    83 %% process as sys:get_status/1 would). Pass through a function which
    84 %% can be invoked on the state, get back the result. The state is not
    85 %% modified.
    86 %%
    87 %% 10) an mcall/1 function has been added for performing multiple
    88 %% call/3 in parallel. Unlike multi_call, which sends the same request
    89 %% to same-named processes residing on a supplied list of nodes, it
    90 %% operates on name/request pairs, where name is anything accepted by
    91 %% call/3, i.e. a pid, global name, local name, or local name on a
    92 %% particular node.
    93 %%
    94 
    95 %% All modifications are (C) 2009-2013 GoPivotal, Inc.
    96 
    97 %% ``The contents of this file are subject to the Erlang Public License,
    98 %% Version 1.1, (the "License"); you may not use this file except in
    99 %% compliance with the License. You should have received a copy of the
   100 %% Erlang Public License along with this software. If not, it can be
   101 %% retrieved via the world wide web at http://www.erlang.org/.
   102 %%
   103 %% Software distributed under the License is distributed on an "AS IS"
   104 %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   105 %% the License for the specific language governing rights and limitations
   106 %% under the License.
   107 %%
   108 %% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
   109 %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
   110 %% AB. All Rights Reserved.''
   111 %%
   112 %%     $Id$
   113 %%
   114 -module(gen_server2).
   115 
   116 %%% ---------------------------------------------------
   117 %%%
   118 %%% The idea behind THIS server is that the user module
   119 %%% provides (different) functions to handle different
   120 %%% kind of inputs.
   121 %%% If the Parent process terminates the Module:terminate/2
   122 %%% function is called.
   123 %%%
   124 %%% The user module should export:
   125 %%%
   126 %%%   init(Args)
   127 %%%     ==> {ok, State}
   128 %%%         {ok, State, Timeout}
   129 %%%         {ok, State, Timeout, Backoff}
   130 %%%         {ok, State, Timeout, Backoff, Module}
   131 %%%         ignore
   132 %%%         {stop, Reason}
   133 %%%
   134 %%%   handle_call(Msg, {From, Tag}, State)
   135 %%%
   136 %%%    ==> {reply, Reply, State}
   137 %%%        {reply, Reply, State, Timeout}
   138 %%%        {noreply, State}
   139 %%%        {noreply, State, Timeout}
   140 %%%        {stop, Reason, Reply, State}
   141 %%%              Reason = normal | shutdown | Term terminate(State) is called
   142 %%%
   143 %%%   handle_cast(Msg, State)
   144 %%%
   145 %%%    ==> {noreply, State}
   146 %%%        {noreply, State, Timeout}
   147 %%%        {stop, Reason, State}
   148 %%%              Reason = normal | shutdown | Term terminate(State) is called
   149 %%%
   150 %%%   handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ...
   151 %%%
   152 %%%    ==> {noreply, State}
   153 %%%        {noreply, State, Timeout}
   154 %%%        {stop, Reason, State}
   155 %%%              Reason = normal | shutdown | Term, terminate(State) is called
   156 %%%
   157 %%%   terminate(Reason, State) Let the user module clean up
   158 %%%              Reason = normal | shutdown | {shutdown, Term} | Term
   159 %%%        always called when server terminates
   160 %%%
   161 %%%    ==> ok | Term
   162 %%%
   163 %%%   handle_pre_hibernate(State)
   164 %%%
   165 %%%    ==> {hibernate, State}
   166 %%%        {stop, Reason, State}
   167 %%%              Reason = normal | shutdown | Term, terminate(State) is called
   168 %%%
   169 %%%   handle_post_hibernate(State)
   170 %%%
   171 %%%    ==> {noreply, State}
   172 %%%        {stop, Reason, State}
   173 %%%              Reason = normal | shutdown | Term, terminate(State) is called
   174 %%%
   175 %%% The work flow (of the server) can be described as follows:
   176 %%%
   177 %%%   User module                          Generic
   178 %%%   -----------                          -------
   179 %%%     start            ----->             start
   180 %%%     init             <-----              .
   181 %%%
   182 %%%                                         loop
   183 %%%     handle_call      <-----              .
   184 %%%                      ----->             reply
   185 %%%
   186 %%%     handle_cast      <-----              .
   187 %%%
   188 %%%     handle_info      <-----              .
   189 %%%
   190 %%%     terminate        <-----              .
   191 %%%
   192 %%%                      ----->             reply
   193 %%%
   194 %%%
   195 %%% ---------------------------------------------------
   196 
   197 %% API
   198 -export([start/3, start/4,
   199          start_link/3, start_link/4,
   200          call/2, call/3,
   201          cast/2, reply/2,
   202          abcast/2, abcast/3,
   203          multi_call/2, multi_call/3, multi_call/4,
   204          mcall/1,
   205          with_state/2,
   206          enter_loop/3, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/1]).
   207 
   208 %% System exports
   209 -export([system_continue/3,
   210          system_terminate/4,
   211          system_code_change/4,
   212          format_status/2]).
   213 
   214 %% Internal exports
   215 -export([init_it/6]).
   216 
   217 -import(error_logger, [format/2]).
   218 
   219 %% State record
   220 -record(gs2_state, {parent, name, state, mod, time,
   221                     timeout_state, queue, debug, prioritisers}).
   222 
   223 -ifdef(use_specs).
   224 
   225 %%%=========================================================================
   226 %%%  Specs. These exist only to shut up dialyzer's warnings
   227 %%%=========================================================================
   228 
   229 -type(gs2_state() :: #gs2_state{}).
   230 
   231 -spec(handle_common_termination/3 ::
   232         (any(), atom(), gs2_state()) -> no_return()).
   233 -spec(hibernate/1 :: (gs2_state()) -> no_return()).
   234 -spec(pre_hibernate/1 :: (gs2_state()) -> no_return()).
   235 -spec(system_terminate/4 :: (_, _, _, gs2_state()) -> no_return()).
   236 
   237 -type(millis() :: non_neg_integer()).
   238 
   239 %%%=========================================================================
   240 %%%  API
   241 %%%=========================================================================
   242 
   243 -callback init(Args :: term()) ->
   244     {ok, State :: term()} |
   245     {ok, State :: term(), timeout() | hibernate} |
   246     {ok, State :: term(), timeout() | hibernate,
   247      {backoff, millis(), millis(), millis()}} |
   248     {ok, State :: term(), timeout() | hibernate,
   249      {backoff, millis(), millis(), millis()}, atom()} |
   250     ignore |
   251     {stop, Reason :: term()}.
   252 -callback handle_call(Request :: term(), From :: {pid(), Tag :: term()},
   253                       State :: term()) ->
   254     {reply, Reply :: term(), NewState :: term()} |
   255     {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} |
   256     {noreply, NewState :: term()} |
   257     {noreply, NewState :: term(), timeout() | hibernate} |
   258     {stop, Reason :: term(),
   259      Reply :: term(), NewState :: term()}.
   260 -callback handle_cast(Request :: term(), State :: term()) ->
   261     {noreply, NewState :: term()} |
   262     {noreply, NewState :: term(), timeout() | hibernate} |
   263     {stop, Reason :: term(), NewState :: term()}.
   264 -callback handle_info(Info :: term(), State :: term()) ->
   265     {noreply, NewState :: term()} |
   266     {noreply, NewState :: term(), timeout() | hibernate} |
   267     {stop, Reason :: term(), NewState :: term()}.
   268 -callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()),
   269                     State :: term()) ->
   270     ok | term().
   271 -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(),
   272                       Extra :: term()) ->
   273     {ok, NewState :: term()} | {error, Reason :: term()}.
   274 
   275 %% It's not possible to define "optional" -callbacks, so putting specs
   276 %% for handle_pre_hibernate/1 and handle_post_hibernate/1 will result
   277 %% in warnings (the same applied for the behaviour_info before).
   278 
   279 -else.
   280 
   281 -export([behaviour_info/1]).
   282 
   283 behaviour_info(callbacks) ->
   284     [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},
   285      {terminate,2},{code_change,3}];
   286 behaviour_info(_Other) ->
   287     undefined.
   288 
   289 -endif.
   290 
   291 %%%  -----------------------------------------------------------------
   292 %%% Starts a generic server.
   293 %%% start(Mod, Args, Options)
   294 %%% start(Name, Mod, Args, Options)
   295 %%% start_link(Mod, Args, Options)
   296 %%% start_link(Name, Mod, Args, Options) where:
   297 %%%    Name ::= {local, atom()} | {global, atom()}
   298 %%%    Mod  ::= atom(), callback module implementing the 'real' server
   299 %%%    Args ::= term(), init arguments (to Mod:init/1)
   300 %%%    Options ::= [{timeout, Timeout} | {debug, [Flag]}]
   301 %%%      Flag ::= trace | log | {logfile, File} | statistics | debug
   302 %%%          (debug == log && statistics)
   303 %%% Returns: {ok, Pid} |
   304 %%%          {error, {already_started, Pid}} |
   305 %%%          {error, Reason}
   306 %%% -----------------------------------------------------------------
   307 start(Mod, Args, Options) ->
   308     gen:start(?MODULE, nolink, Mod, Args, Options).
   309 
   310 start(Name, Mod, Args, Options) ->
   311     gen:start(?MODULE, nolink, Name, Mod, Args, Options).
   312 
   313 start_link(Mod, Args, Options) ->
   314     gen:start(?MODULE, link, Mod, Args, Options).
   315 
   316 start_link(Name, Mod, Args, Options) ->
   317     gen:start(?MODULE, link, Name, Mod, Args, Options).
   318 
   319 
   320 %% -----------------------------------------------------------------
   321 %% Make a call to a generic server.
   322 %% If the server is located at another node, that node will
   323 %% be monitored.
   324 %% If the client is trapping exits and is linked server termination
   325 %% is handled here (? Shall we do that here (or rely on timeouts) ?).
   326 %% -----------------------------------------------------------------
   327 call(Name, Request) ->
   328     case catch gen:call(Name, '$gen_call', Request) of
   329         {ok,Res} ->
   330             Res;
   331         {'EXIT',Reason} ->
   332             exit({Reason, {?MODULE, call, [Name, Request]}})
   333     end.
   334 
   335 call(Name, Request, Timeout) ->
   336     case catch gen:call(Name, '$gen_call', Request, Timeout) of
   337         {ok,Res} ->
   338             Res;
   339         {'EXIT',Reason} ->
   340             exit({Reason, {?MODULE, call, [Name, Request, Timeout]}})
   341     end.
   342 
   343 %% -----------------------------------------------------------------
   344 %% Make a cast to a generic server.
   345 %% -----------------------------------------------------------------
   346 cast({global,Name}, Request) ->
   347     catch global:send(Name, cast_msg(Request)),
   348     ok;
   349 cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) ->
   350     do_cast(Dest, Request);
   351 cast(Dest, Request) when is_atom(Dest) ->
   352     do_cast(Dest, Request);
   353 cast(Dest, Request) when is_pid(Dest) ->
   354     do_cast(Dest, Request).
   355 
   356 do_cast(Dest, Request) ->
   357     do_send(Dest, cast_msg(Request)),
   358     ok.
   359 
   360 cast_msg(Request) -> {'$gen_cast',Request}.
   361 
   362 %% -----------------------------------------------------------------
   363 %% Send a reply to the client.
   364 %% -----------------------------------------------------------------
   365 reply({To, Tag}, Reply) ->
   366     catch To ! {Tag, Reply}.
   367 
   368 %% -----------------------------------------------------------------
   369 %% Asyncronous broadcast, returns nothing, it's just send'n pray
   370 %% -----------------------------------------------------------------
   371 abcast(Name, Request) when is_atom(Name) ->
   372     do_abcast([node() | nodes()], Name, cast_msg(Request)).
   373 
   374 abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) ->
   375     do_abcast(Nodes, Name, cast_msg(Request)).
   376 
   377 do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) ->
   378     do_send({Name,Node},Msg),
   379     do_abcast(Nodes, Name, Msg);
   380 do_abcast([], _,_) -> abcast.
   381 
   382 %%% -----------------------------------------------------------------
   383 %%% Make a call to servers at several nodes.
   384 %%% Returns: {[Replies],[BadNodes]}
   385 %%% A Timeout can be given
   386 %%%
   387 %%% A middleman process is used in case late answers arrives after
   388 %%% the timeout. If they would be allowed to glog the callers message
   389 %%% queue, it would probably become confused. Late answers will
   390 %%% now arrive to the terminated middleman and so be discarded.
   391 %%% -----------------------------------------------------------------
   392 multi_call(Name, Req)
   393   when is_atom(Name) ->
   394     do_multi_call([node() | nodes()], Name, Req, infinity).
   395 
   396 multi_call(Nodes, Name, Req)
   397   when is_list(Nodes), is_atom(Name) ->
   398     do_multi_call(Nodes, Name, Req, infinity).
   399 
   400 multi_call(Nodes, Name, Req, infinity) ->
   401     do_multi_call(Nodes, Name, Req, infinity);
   402 multi_call(Nodes, Name, Req, Timeout)
   403   when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
   404     do_multi_call(Nodes, Name, Req, Timeout).
   405 
   406 %%% -----------------------------------------------------------------
   407 %%% Make multiple calls to multiple servers, given pairs of servers
   408 %%% and messages.
   409 %%% Returns: {[{Dest, Reply}], [{Dest, Error}]}
   410 %%%
   411 %%% Dest can be pid() | RegName :: atom() |
   412 %%%             {Name :: atom(), Node :: atom()} | {global, Name :: atom()}
   413 %%%
   414 %%% A middleman process is used to avoid clogging up the callers
   415 %%% message queue.
   416 %%% -----------------------------------------------------------------
   417 mcall(CallSpecs) ->
   418     Tag = make_ref(),
   419     {_, MRef} = spawn_monitor(
   420                   fun() ->
   421                           Refs = lists:foldl(
   422                                    fun ({Dest, _Request}=S, Dict) ->
   423                                            dict:store(do_mcall(S), Dest, Dict)
   424                                    end, dict:new(), CallSpecs),
   425                           collect_replies(Tag, Refs, [], [])
   426                   end),
   427     receive
   428         {'DOWN', MRef, _, _, {Tag, Result}} -> Result;
   429         {'DOWN', MRef, _, _, Reason}        -> exit(Reason)
   430     end.
   431 
   432 do_mcall({{global,Name}=Dest, Request}) ->
   433     %% whereis_name is simply an ets lookup, and is precisely what
   434     %% global:send/2 does, yet we need a Ref to put in the call to the
   435     %% server, so invoking whereis_name makes a lot more sense here.
   436     case global:whereis_name(Name) of
   437         Pid when is_pid(Pid) ->
   438             MRef = erlang:monitor(process, Pid),
   439             catch msend(Pid, MRef, Request),
   440             MRef;
   441         undefined ->
   442             Ref = make_ref(),
   443             self() ! {'DOWN', Ref, process, Dest, noproc},
   444             Ref
   445     end;
   446 do_mcall({{Name,Node}=Dest, Request}) when is_atom(Name), is_atom(Node) ->
   447     {_Node, MRef} = start_monitor(Node, Name), %% NB: we don't handle R6
   448     catch msend(Dest, MRef, Request),
   449     MRef;
   450 do_mcall({Dest, Request}) when is_atom(Dest); is_pid(Dest) ->
   451     MRef = erlang:monitor(process, Dest),
   452     catch msend(Dest, MRef, Request),
   453     MRef.
   454 
   455 msend(Dest, MRef, Request) ->
   456     erlang:send(Dest, {'$gen_call', {self(), MRef}, Request}, [noconnect]).
   457 
   458 collect_replies(Tag, Refs, Replies, Errors) ->
   459     case dict:size(Refs) of
   460         0 -> exit({Tag, {Replies, Errors}});
   461         _ -> receive
   462                  {MRef, Reply} ->
   463                      {Refs1, Replies1} = handle_call_result(MRef, Reply,
   464                                                             Refs, Replies),
   465                      collect_replies(Tag, Refs1, Replies1, Errors);
   466                  {'DOWN', MRef, _, _, Reason} ->
   467                      Reason1 = case Reason of
   468                                    noconnection -> nodedown;
   469                                    _            -> Reason
   470                                end,
   471                      {Refs1, Errors1} = handle_call_result(MRef, Reason1,
   472                                                            Refs, Errors),
   473                      collect_replies(Tag, Refs1, Replies, Errors1)
   474              end
   475     end.
   476 
   477 handle_call_result(MRef, Result, Refs, AccList) ->
   478     %% we avoid the mailbox scanning cost of a call to erlang:demonitor/{1,2}
   479     %% here, so we must cope with MRefs that we've already seen and erased
   480     case dict:find(MRef, Refs) of
   481         {ok, Pid} -> {dict:erase(MRef, Refs), [{Pid, Result}|AccList]};
   482         _         -> {Refs, AccList}
   483     end.
   484 
   485 %% -----------------------------------------------------------------
   486 %% Apply a function to a generic server's state.
   487 %% -----------------------------------------------------------------
   488 with_state(Name, Fun) ->
   489     case catch gen:call(Name, '$with_state', Fun, infinity) of
   490         {ok,Res} ->
   491             Res;
   492         {'EXIT',Reason} ->
   493             exit({Reason, {?MODULE, with_state, [Name, Fun]}})
   494     end.
   495 
   496 %%-----------------------------------------------------------------
   497 %% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>, <Backoff>) ->_
   498 %%
   499 %% Description: Makes an existing process into a gen_server.
   500 %%              The calling process will enter the gen_server receive
   501 %%              loop and become a gen_server process.
   502 %%              The process *must* have been started using one of the
   503 %%              start functions in proc_lib, see proc_lib(3).
   504 %%              The user is responsible for any initialization of the
   505 %%              process, including registering a name for it.
   506 %%-----------------------------------------------------------------
   507 enter_loop(Mod, Options, State) ->
   508     enter_loop(Mod, Options, State, self(), infinity, undefined).
   509 
   510 enter_loop(Mod, Options, State, Backoff = {backoff, _, _ , _}) ->
   511     enter_loop(Mod, Options, State, self(), infinity, Backoff);
   512 
   513 enter_loop(Mod, Options, State, ServerName = {_, _}) ->
   514     enter_loop(Mod, Options, State, ServerName, infinity, undefined);
   515 
   516 enter_loop(Mod, Options, State, Timeout) ->
   517     enter_loop(Mod, Options, State, self(), Timeout, undefined).
   518 
   519 enter_loop(Mod, Options, State, ServerName, Backoff = {backoff, _, _, _}) ->
   520     enter_loop(Mod, Options, State, ServerName, infinity, Backoff);
   521 
   522 enter_loop(Mod, Options, State, ServerName, Timeout) ->
   523     enter_loop(Mod, Options, State, ServerName, Timeout, undefined).
   524 
   525 enter_loop(Mod, Options, State, ServerName, Timeout, Backoff) ->
   526     Name = get_proc_name(ServerName),
   527     Parent = get_parent(),
   528     Debug = debug_options(Name, Options),
   529     Queue = priority_queue:new(),
   530     Backoff1 = extend_backoff(Backoff),
   531     loop(find_prioritisers(
   532            #gs2_state { parent = Parent, name = Name, state = State,
   533                         mod = Mod, time = Timeout, timeout_state = Backoff1,
   534                         queue = Queue, debug = Debug })).
   535 
   536 %%%========================================================================
   537 %%% Gen-callback functions
   538 %%%========================================================================
   539 
   540 %%% ---------------------------------------------------
   541 %%% Initiate the new process.
   542 %%% Register the name using the Rfunc function
   543 %%% Calls the Mod:init/Args function.
   544 %%% Finally an acknowledge is sent to Parent and the main
   545 %%% loop is entered.
   546 %%% ---------------------------------------------------
   547 init_it(Starter, self, Name, Mod, Args, Options) ->
   548     init_it(Starter, self(), Name, Mod, Args, Options);
   549 init_it(Starter, Parent, Name0, Mod, Args, Options) ->
   550     Name = name(Name0),
   551     Debug = debug_options(Name, Options),
   552     Queue = priority_queue:new(),
   553     GS2State = find_prioritisers(
   554                  #gs2_state { parent  = Parent,
   555                               name    = Name,
   556                               mod     = Mod,
   557                               queue   = Queue,
   558                               debug   = Debug }),
   559     case catch Mod:init(Args) of
   560         {ok, State} ->
   561             proc_lib:init_ack(Starter, {ok, self()}),
   562             loop(GS2State #gs2_state { state         = State,
   563                                        time          = infinity,
   564                                        timeout_state = undefined });
   565         {ok, State, Timeout} ->
   566             proc_lib:init_ack(Starter, {ok, self()}),
   567             loop(GS2State #gs2_state { state         = State,
   568                                        time          = Timeout,
   569                                        timeout_state = undefined });
   570         {ok, State, Timeout, Backoff = {backoff, _, _, _}} ->
   571             Backoff1 = extend_backoff(Backoff),
   572             proc_lib:init_ack(Starter, {ok, self()}),
   573             loop(GS2State #gs2_state { state         = State,
   574                                        time          = Timeout,
   575                                        timeout_state = Backoff1 });
   576         {ok, State, Timeout, Backoff = {backoff, _, _, _}, Mod1} ->
   577             Backoff1 = extend_backoff(Backoff),
   578             proc_lib:init_ack(Starter, {ok, self()}),
   579             loop(GS2State #gs2_state { mod           = Mod1,
   580                                        state         = State,
   581                                        time          = Timeout,
   582                                        timeout_state = Backoff1 });
   583         {stop, Reason} ->
   584             %% For consistency, we must make sure that the
   585             %% registered name (if any) is unregistered before
   586             %% the parent process is notified about the failure.
   587             %% (Otherwise, the parent process could get
   588             %% an 'already_started' error if it immediately
   589             %% tried starting the process again.)
   590             unregister_name(Name0),
   591             proc_lib:init_ack(Starter, {error, Reason}),
   592             exit(Reason);
   593         ignore ->
   594             unregister_name(Name0),
   595             proc_lib:init_ack(Starter, ignore),
   596             exit(normal);
   597         {'EXIT', Reason} ->
   598             unregister_name(Name0),
   599             proc_lib:init_ack(Starter, {error, Reason}),
   600             exit(Reason);
   601         Else ->
   602             Error = {bad_return_value, Else},
   603             proc_lib:init_ack(Starter, {error, Error}),
   604             exit(Error)
   605     end.
   606 
   607 name({local,Name}) -> Name;
   608 name({global,Name}) -> Name;
   609 %% name(Pid) when is_pid(Pid) -> Pid;
   610 %% when R12 goes away, drop the line beneath and uncomment the line above
   611 name(Name) -> Name.
   612 
   613 unregister_name({local,Name}) ->
   614     _ = (catch unregister(Name));
   615 unregister_name({global,Name}) ->
   616     _ = global:unregister_name(Name);
   617 unregister_name(Pid) when is_pid(Pid) ->
   618     Pid;
   619 %% Under R12 let's just ignore it, as we have a single term as Name.
   620 %% On R13 it will never get here, as we get tuple with 'local/global' atom.
   621 unregister_name(_Name) -> ok.
   622 
   623 extend_backoff(undefined) ->
   624     undefined;
   625 extend_backoff({backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod}) ->
   626     {backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod, now()}.
   627 
   628 %%%========================================================================
   629 %%% Internal functions
   630 %%%========================================================================
   631 %%% ---------------------------------------------------
   632 %%% The MAIN loop.
   633 %%% ---------------------------------------------------
   634 loop(GS2State = #gs2_state { time          = hibernate,
   635                              timeout_state = undefined }) ->
   636     pre_hibernate(GS2State);
   637 loop(GS2State) ->
   638     process_next_msg(drain(GS2State)).
   639 
   640 drain(GS2State) ->
   641     receive
   642         Input -> drain(in(Input, GS2State))
   643     after 0 -> GS2State
   644     end.
   645 
   646 process_next_msg(GS2State = #gs2_state { time          = Time,
   647                                          timeout_state = TimeoutState,
   648                                          queue         = Queue }) ->
   649     case priority_queue:out(Queue) of
   650         {{value, Msg}, Queue1} ->
   651             process_msg(Msg, GS2State #gs2_state { queue = Queue1 });
   652         {empty, Queue1} ->
   653             {Time1, HibOnTimeout}
   654                 = case {Time, TimeoutState} of
   655                       {hibernate, {backoff, Current, _Min, _Desired, _RSt}} ->
   656                           {Current, true};
   657                       {hibernate, _} ->
   658                           %% wake_hib/7 will set Time to hibernate. If
   659                           %% we were woken and didn't receive a msg
   660                           %% then we will get here and need a sensible
   661                           %% value for Time1, otherwise we crash.
   662                           %% R13B1 always waits infinitely when waking
   663                           %% from hibernation, so that's what we do
   664                           %% here too.
   665                           {infinity, false};
   666                       _ -> {Time, false}
   667                   end,
   668             receive
   669                 Input ->
   670                     %% Time could be 'hibernate' here, so *don't* call loop
   671                     process_next_msg(
   672                       drain(in(Input, GS2State #gs2_state { queue = Queue1 })))
   673             after Time1 ->
   674                     case HibOnTimeout of
   675                         true ->
   676                             pre_hibernate(
   677                               GS2State #gs2_state { queue = Queue1 });
   678                         false ->
   679                             process_msg(timeout,
   680                                         GS2State #gs2_state { queue = Queue1 })
   681                     end
   682             end
   683     end.
   684 
   685 wake_hib(GS2State = #gs2_state { timeout_state = TS }) ->
   686     TimeoutState1 = case TS of
   687                         undefined ->
   688                             undefined;
   689                         {SleptAt, TimeoutState} ->
   690                             adjust_timeout_state(SleptAt, now(), TimeoutState)
   691                     end,
   692     post_hibernate(
   693       drain(GS2State #gs2_state { timeout_state = TimeoutState1 })).
   694 
   695 hibernate(GS2State = #gs2_state { timeout_state = TimeoutState }) ->
   696     TS = case TimeoutState of
   697              undefined             -> undefined;
   698              {backoff, _, _, _, _} -> {now(), TimeoutState}
   699          end,
   700     proc_lib:hibernate(?MODULE, wake_hib,
   701                        [GS2State #gs2_state { timeout_state = TS }]).
   702 
   703 pre_hibernate(GS2State = #gs2_state { state   = State,
   704                                       mod     = Mod }) ->
   705     case erlang:function_exported(Mod, handle_pre_hibernate, 1) of
   706         true ->
   707             case catch Mod:handle_pre_hibernate(State) of
   708                 {hibernate, NState} ->
   709                     hibernate(GS2State #gs2_state { state = NState } );
   710                 Reply ->
   711                     handle_common_termination(Reply, pre_hibernate, GS2State)
   712             end;
   713         false ->
   714             hibernate(GS2State)
   715     end.
   716 
   717 post_hibernate(GS2State = #gs2_state { state = State,
   718                                        mod   = Mod }) ->
   719     case erlang:function_exported(Mod, handle_post_hibernate, 1) of
   720         true ->
   721             case catch Mod:handle_post_hibernate(State) of
   722                 {noreply, NState} ->
   723                     process_next_msg(GS2State #gs2_state { state = NState,
   724                                                            time  = infinity });
   725                 {noreply, NState, Time} ->
   726                     process_next_msg(GS2State #gs2_state { state = NState,
   727                                                            time  = Time });
   728                 Reply ->
   729                     handle_common_termination(Reply, post_hibernate, GS2State)
   730             end;
   731         false ->
   732             %% use hibernate here, not infinity. This matches
   733             %% R13B. The key is that we should be able to get through
   734             %% to process_msg calling sys:handle_system_msg with Time
   735             %% still set to hibernate, iff that msg is the very msg
   736             %% that woke us up (or the first msg we receive after
   737             %% waking up).
   738             process_next_msg(GS2State #gs2_state { time = hibernate })
   739     end.
   740 
   741 adjust_timeout_state(SleptAt, AwokeAt, {backoff, CurrentTO, MinimumTO,
   742                                         DesiredHibPeriod, RandomState}) ->
   743     NapLengthMicros = timer:now_diff(AwokeAt, SleptAt),
   744     CurrentMicros = CurrentTO * 1000,
   745     MinimumMicros = MinimumTO * 1000,
   746     DesiredHibMicros = DesiredHibPeriod * 1000,
   747     GapBetweenMessagesMicros = NapLengthMicros + CurrentMicros,
   748     Base =
   749         %% If enough time has passed between the last two messages then we
   750         %% should consider sleeping sooner. Otherwise stay awake longer.
   751         case GapBetweenMessagesMicros > (MinimumMicros + DesiredHibMicros) of
   752             true -> lists:max([MinimumTO, CurrentTO div 2]);
   753             false -> CurrentTO
   754         end,
   755     {Extra, RandomState1} = random:uniform_s(Base, RandomState),
   756     CurrentTO1 = Base + Extra,
   757     {backoff, CurrentTO1, MinimumTO, DesiredHibPeriod, RandomState1}.
   758 
   759 in({'$gen_cast', Msg} = Input,
   760    GS2State = #gs2_state { prioritisers = {_, F, _} }) ->
   761     in(Input, F(Msg, GS2State), GS2State);
   762 in({'$gen_call', From, Msg} = Input,
   763    GS2State = #gs2_state { prioritisers = {F, _, _} }) ->
   764     in(Input, F(Msg, From, GS2State), GS2State);
   765 in({'$with_state', _From, _Fun} = Input, GS2State) ->
   766     in(Input, 0, GS2State);
   767 in({'EXIT', Parent, _R} = Input, GS2State = #gs2_state { parent = Parent }) ->
   768     in(Input, infinity, GS2State);
   769 in({system, _From, _Req} = Input, GS2State) ->
   770     in(Input, infinity, GS2State);
   771 in(Input, GS2State = #gs2_state { prioritisers = {_, _, F} }) ->
   772     in(Input, F(Input, GS2State), GS2State).
   773 
   774 in(_Input, drop, GS2State) ->
   775     GS2State;
   776 
   777 in(Input, Priority, GS2State = #gs2_state { queue = Queue }) ->
   778     GS2State # gs2_state { queue = priority_queue:in(Input, Priority, Queue) }.
   779 
   780 process_msg({system, From, Req},
   781             GS2State = #gs2_state { parent = Parent, debug  = Debug }) ->
   782     %% gen_server puts Hib on the end as the 7th arg, but that version
   783     %% of the fun seems not to be documented so leaving out for now.
   784     sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, GS2State);
   785 process_msg({'$with_state', From, Fun},
   786            GS2State = #gs2_state{state = State}) ->
   787     reply(From, catch Fun(State)),
   788     loop(GS2State);
   789 process_msg({'EXIT', Parent, Reason} = Msg,
   790             GS2State = #gs2_state { parent = Parent }) ->
   791     terminate(Reason, Msg, GS2State);
   792 process_msg(Msg, GS2State = #gs2_state { debug  = [] }) ->
   793     handle_msg(Msg, GS2State);
   794 process_msg(Msg, GS2State = #gs2_state { name = Name, debug  = Debug }) ->
   795     Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {in, Msg}),
   796     handle_msg(Msg, GS2State #gs2_state { debug = Debug1 }).
   797 
   798 %%% ---------------------------------------------------
   799 %%% Send/recive functions
   800 %%% ---------------------------------------------------
   801 do_send(Dest, Msg) ->
   802     catch erlang:send(Dest, Msg).
   803 
   804 do_multi_call(Nodes, Name, Req, infinity) ->
   805     Tag = make_ref(),
   806     Monitors = send_nodes(Nodes, Name, Tag, Req),
   807     rec_nodes(Tag, Monitors, Name, undefined);
   808 do_multi_call(Nodes, Name, Req, Timeout) ->
   809     Tag = make_ref(),
   810     Caller = self(),
   811     Receiver =
   812         spawn(
   813           fun () ->
   814                   %% Middleman process. Should be unsensitive to regular
   815                   %% exit signals. The sychronization is needed in case
   816                   %% the receiver would exit before the caller started
   817                   %% the monitor.
   818                   process_flag(trap_exit, true),
   819                   Mref = erlang:monitor(process, Caller),
   820                   receive
   821                       {Caller,Tag} ->
   822                           Monitors = send_nodes(Nodes, Name, Tag, Req),
   823                           TimerId = erlang:start_timer(Timeout, self(), ok),
   824                           Result = rec_nodes(Tag, Monitors, Name, TimerId),
   825                           exit({self(),Tag,Result});
   826                       {'DOWN',Mref,_,_,_} ->
   827                           %% Caller died before sending us the go-ahead.
   828                           %% Give up silently.
   829                           exit(normal)
   830                   end
   831           end),
   832     Mref = erlang:monitor(process, Receiver),
   833     Receiver ! {self(),Tag},
   834     receive
   835         {'DOWN',Mref,_,_,{Receiver,Tag,Result}} ->
   836             Result;
   837         {'DOWN',Mref,_,_,Reason} ->
   838             %% The middleman code failed. Or someone did
   839             %% exit(_, kill) on the middleman process => Reason==killed
   840             exit(Reason)
   841     end.
   842 
   843 send_nodes(Nodes, Name, Tag, Req) ->
   844     send_nodes(Nodes, Name, Tag, Req, []).
   845 
   846 send_nodes([Node|Tail], Name, Tag, Req, Monitors)
   847   when is_atom(Node) ->
   848     Monitor = start_monitor(Node, Name),
   849     %% Handle non-existing names in rec_nodes.
   850     catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req},
   851     send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]);
   852 send_nodes([_Node|Tail], Name, Tag, Req, Monitors) ->
   853     %% Skip non-atom Node
   854     send_nodes(Tail, Name, Tag, Req, Monitors);
   855 send_nodes([], _Name, _Tag, _Req, Monitors) ->
   856     Monitors.
   857 
   858 %% Against old nodes:
   859 %% If no reply has been delivered within 2 secs. (per node) check that
   860 %% the server really exists and wait for ever for the answer.
   861 %%
   862 %% Against contemporary nodes:
   863 %% Wait for reply, server 'DOWN', or timeout from TimerId.
   864 
   865 rec_nodes(Tag, Nodes, Name, TimerId) ->
   866     rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId).
   867 
   868 rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) ->
   869     receive
   870         {'DOWN', R, _, _, _} ->
   871             rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId);
   872         {{Tag, N}, Reply} ->  %% Tag is bound !!!
   873             unmonitor(R),
   874             rec_nodes(Tag, Tail, Name, Badnodes,
   875                       [{N,Reply}|Replies], Time, TimerId);
   876         {timeout, TimerId, _} ->
   877             unmonitor(R),
   878             %% Collect all replies that already have arrived
   879             rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   880     end;
   881 rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) ->
   882     %% R6 node
   883     receive
   884         {nodedown, N} ->
   885             monitor_node(N, false),
   886             rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId);
   887         {{Tag, N}, Reply} ->  %% Tag is bound !!!
   888             receive {nodedown, N} -> ok after 0 -> ok end,
   889             monitor_node(N, false),
   890             rec_nodes(Tag, Tail, Name, Badnodes,
   891                       [{N,Reply}|Replies], 2000, TimerId);
   892         {timeout, TimerId, _} ->
   893             receive {nodedown, N} -> ok after 0 -> ok end,
   894             monitor_node(N, false),
   895             %% Collect all replies that already have arrived
   896             rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies)
   897     after Time ->
   898             case rpc:call(N, erlang, whereis, [Name]) of
   899                 Pid when is_pid(Pid) -> % It exists try again.
   900                     rec_nodes(Tag, [N|Tail], Name, Badnodes,
   901                               Replies, infinity, TimerId);
   902                 _ -> % badnode
   903                     receive {nodedown, N} -> ok after 0 -> ok end,
   904                     monitor_node(N, false),
   905                     rec_nodes(Tag, Tail, Name, [N|Badnodes],
   906                               Replies, 2000, TimerId)
   907             end
   908     end;
   909 rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) ->
   910     case catch erlang:cancel_timer(TimerId) of
   911         false ->  % It has already sent it's message
   912             receive
   913                 {timeout, TimerId, _} -> ok
   914             after 0 ->
   915                     ok
   916             end;
   917         _ -> % Timer was cancelled, or TimerId was 'undefined'
   918             ok
   919     end,
   920     {Replies, Badnodes}.
   921 
   922 %% Collect all replies that already have arrived
   923 rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) ->
   924     receive
   925         {'DOWN', R, _, _, _} ->
   926             rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
   927         {{Tag, N}, Reply} -> %% Tag is bound !!!
   928             unmonitor(R),
   929             rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
   930     after 0 ->
   931             unmonitor(R),
   932             rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   933     end;
   934 rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) ->
   935     %% R6 node
   936     receive
   937         {nodedown, N} ->
   938             monitor_node(N, false),
   939             rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);
   940         {{Tag, N}, Reply} ->  %% Tag is bound !!!
   941             receive {nodedown, N} -> ok after 0 -> ok end,
   942             monitor_node(N, false),
   943             rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])
   944     after 0 ->
   945             receive {nodedown, N} -> ok after 0 -> ok end,
   946             monitor_node(N, false),
   947             rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)
   948     end;
   949 rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) ->
   950     {Replies, Badnodes}.
   951 
   952 
   953 %%% ---------------------------------------------------
   954 %%% Monitor functions
   955 %%% ---------------------------------------------------
   956 
   957 start_monitor(Node, Name) when is_atom(Node), is_atom(Name) ->
   958     if node() =:= nonode@nohost, Node =/= nonode@nohost ->
   959             Ref = make_ref(),
   960             self() ! {'DOWN', Ref, process, {Name, Node}, noconnection},
   961             {Node, Ref};
   962        true ->
   963             case catch erlang:monitor(process, {Name, Node}) of
   964                 {'EXIT', _} ->
   965                     %% Remote node is R6
   966                     monitor_node(Node, true),
   967                     Node;
   968                 Ref when is_reference(Ref) ->
   969                     {Node, Ref}
   970             end
   971     end.
   972 
   973 %% Cancels a monitor started with Ref=erlang:monitor(_, _).
   974 unmonitor(Ref) when is_reference(Ref) ->
   975     erlang:demonitor(Ref),
   976     receive
   977         {'DOWN', Ref, _, _, _} ->
   978             true
   979     after 0 ->
   980             true
   981     end.
   982 
   983 %%% ---------------------------------------------------
   984 %%% Message handling functions
   985 %%% ---------------------------------------------------
   986 
   987 dispatch({'$gen_cast', Msg}, Mod, State) ->
   988     Mod:handle_cast(Msg, State);
   989 dispatch(Info, Mod, State) ->
   990     Mod:handle_info(Info, State).
   991 
   992 common_reply(_Name, From, Reply, _NState, [] = _Debug) ->
   993     reply(From, Reply),
   994     [];
   995 common_reply(Name, {To, _Tag} = From, Reply, NState, Debug) ->
   996     reply(From, Reply),
   997     sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, NState}).
   998 
   999 common_noreply(_Name, _NState, [] = _Debug) ->
  1000     [];
  1001 common_noreply(Name, NState, Debug) ->
  1002     sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}).
  1003 
  1004 common_become(_Name, _Mod, _NState, [] = _Debug) ->
  1005     [];
  1006 common_become(Name, Mod, NState, Debug) ->
  1007     sys:handle_debug(Debug, fun print_event/3, Name, {become, Mod, NState}).
  1008 
  1009 handle_msg({'$gen_call', From, Msg}, GS2State = #gs2_state { mod = Mod,
  1010                                                              state = State,
  1011                                                              name = Name,
  1012                                                              debug = Debug }) ->
  1013     case catch Mod:handle_call(Msg, From, State) of
  1014         {reply, Reply, NState} ->
  1015             Debug1 = common_reply(Name, From, Reply, NState, Debug),
  1016             loop(GS2State #gs2_state { state = NState,
  1017                                        time  = infinity,
  1018                                        debug = Debug1 });
  1019         {reply, Reply, NState, Time1} ->
  1020             Debug1 = common_reply(Name, From, Reply, NState, Debug),
  1021             loop(GS2State #gs2_state { state = NState,
  1022                                        time  = Time1,
  1023                                        debug = Debug1});
  1024         {stop, Reason, Reply, NState} ->
  1025             {'EXIT', R} =
  1026                 (catch terminate(Reason, Msg,
  1027                                  GS2State #gs2_state { state = NState })),
  1028             common_reply(Name, From, Reply, NState, Debug),
  1029             exit(R);
  1030         Other ->
  1031             handle_common_reply(Other, Msg, GS2State)
  1032     end;
  1033 handle_msg(Msg, GS2State = #gs2_state { mod = Mod, state = State }) ->
  1034     Reply = (catch dispatch(Msg, Mod, State)),
  1035     handle_common_reply(Reply, Msg, GS2State).
  1036 
  1037 handle_common_reply(Reply, Msg, GS2State = #gs2_state { name  = Name,
  1038                                                         debug = Debug}) ->
  1039     case Reply of
  1040         {noreply, NState} ->
  1041             Debug1 = common_noreply(Name, NState, Debug),
  1042             loop(GS2State #gs2_state {state = NState,
  1043                                       time  = infinity,
  1044                                       debug = Debug1});
  1045         {noreply, NState, Time1} ->
  1046             Debug1 = common_noreply(Name, NState, Debug),
  1047             loop(GS2State #gs2_state {state = NState,
  1048                                       time  = Time1,
  1049                                       debug = Debug1});
  1050         {become, Mod, NState} ->
  1051             Debug1 = common_become(Name, Mod, NState, Debug),
  1052             loop(find_prioritisers(
  1053                    GS2State #gs2_state { mod   = Mod,
  1054                                          state = NState,
  1055                                          time  = infinity,
  1056                                          debug = Debug1 }));
  1057         {become, Mod, NState, Time1} ->
  1058             Debug1 = common_become(Name, Mod, NState, Debug),
  1059             loop(find_prioritisers(
  1060                    GS2State #gs2_state { mod   = Mod,
  1061                                          state = NState,
  1062                                          time  = Time1,
  1063                                          debug = Debug1 }));
  1064         _ ->
  1065             handle_common_termination(Reply, Msg, GS2State)
  1066     end.
  1067 
  1068 handle_common_termination(Reply, Msg, GS2State) ->
  1069     case Reply of
  1070         {stop, Reason, NState} ->
  1071             terminate(Reason, Msg, GS2State #gs2_state { state = NState });
  1072         {'EXIT', What} ->
  1073             terminate(What, Msg, GS2State);
  1074         _ ->
  1075             terminate({bad_return_value, Reply}, Msg, GS2State)
  1076     end.
  1077 
  1078 %%-----------------------------------------------------------------
  1079 %% Callback functions for system messages handling.
  1080 %%-----------------------------------------------------------------
  1081 system_continue(Parent, Debug, GS2State) ->
  1082     loop(GS2State #gs2_state { parent = Parent, debug = Debug }).
  1083 
  1084 system_terminate(Reason, _Parent, Debug, GS2State) ->
  1085     terminate(Reason, [], GS2State #gs2_state { debug = Debug }).
  1086 
  1087 system_code_change(GS2State = #gs2_state { mod   = Mod,
  1088                                            state = State },
  1089                    _Module, OldVsn, Extra) ->
  1090     case catch Mod:code_change(OldVsn, State, Extra) of
  1091         {ok, NewState} ->
  1092             NewGS2State = find_prioritisers(
  1093                             GS2State #gs2_state { state = NewState }),
  1094             {ok, [NewGS2State]};
  1095         Else ->
  1096             Else
  1097     end.
  1098 
  1099 %%-----------------------------------------------------------------
  1100 %% Format debug messages.  Print them as the call-back module sees
  1101 %% them, not as the real erlang messages.  Use trace for that.
  1102 %%-----------------------------------------------------------------
  1103 print_event(Dev, {in, Msg}, Name) ->
  1104     case Msg of
  1105         {'$gen_call', {From, _Tag}, Call} ->
  1106             io:format(Dev, "*DBG* ~p got call ~p from ~w~n",
  1107                       [Name, Call, From]);
  1108         {'$gen_cast', Cast} ->
  1109             io:format(Dev, "*DBG* ~p got cast ~p~n",
  1110                       [Name, Cast]);
  1111         _ ->
  1112             io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
  1113     end;
  1114 print_event(Dev, {out, Msg, To, State}, Name) ->
  1115     io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n",
  1116               [Name, Msg, To, State]);
  1117 print_event(Dev, {noreply, State}, Name) ->
  1118     io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);
  1119 print_event(Dev, Event, Name) ->
  1120     io:format(Dev, "*DBG* ~p dbg  ~p~n", [Name, Event]).
  1121 
  1122 
  1123 %%% ---------------------------------------------------
  1124 %%% Terminate the server.
  1125 %%% ---------------------------------------------------
  1126 
  1127 terminate(Reason, Msg, #gs2_state { name  = Name,
  1128                                     mod   = Mod,
  1129                                     state = State,
  1130                                     debug = Debug }) ->
  1131     case catch Mod:terminate(Reason, State) of
  1132         {'EXIT', R} ->
  1133             error_info(R, Reason, Name, Msg, State, Debug),
  1134             exit(R);
  1135         _ ->
  1136             case Reason of
  1137                 normal ->
  1138                     exit(normal);
  1139                 shutdown ->
  1140                     exit(shutdown);
  1141                 {shutdown,_}=Shutdown ->
  1142                     exit(Shutdown);
  1143                 _ ->
  1144                     error_info(Reason, undefined, Name, Msg, State, Debug),
  1145                     exit(Reason)
  1146             end
  1147     end.
  1148 
  1149 error_info(_Reason, _RootCause, application_controller, _Msg, _State, _Debug) ->
  1150     %% OTP-5811 Don't send an error report if it's the system process
  1151     %% application_controller which is terminating - let init take care
  1152     %% of it instead
  1153     ok;
  1154 error_info(Reason, RootCause, Name, Msg, State, Debug) ->
  1155     Reason1 = error_reason(Reason),
  1156     Fmt =
  1157         "** Generic server ~p terminating~n"
  1158         "** Last message in was ~p~n"
  1159         "** When Server state == ~p~n"
  1160         "** Reason for termination == ~n** ~p~n",
  1161     case RootCause of
  1162         undefined -> format(Fmt, [Name, Msg, State, Reason1]);
  1163         _         -> format(Fmt ++ "** In 'terminate' callback "
  1164                             "with reason ==~n** ~p~n",
  1165                             [Name, Msg, State, Reason1,
  1166                              error_reason(RootCause)])
  1167     end,
  1168     sys:print_log(Debug),
  1169     ok.
  1170 
  1171 error_reason({undef,[{M,F,A}|MFAs]} = Reason) ->
  1172     case code:is_loaded(M) of
  1173         false -> {'module could not be loaded',[{M,F,A}|MFAs]};
  1174         _     -> case erlang:function_exported(M, F, length(A)) of
  1175                      true  -> Reason;
  1176                      false -> {'function not exported',[{M,F,A}|MFAs]}
  1177                  end
  1178     end;
  1179 error_reason(Reason) ->
  1180     Reason.
  1181 
  1182 %%% ---------------------------------------------------
  1183 %%% Misc. functions.
  1184 %%% ---------------------------------------------------
  1185 
  1186 opt(Op, [{Op, Value}|_]) ->
  1187     {ok, Value};
  1188 opt(Op, [_|Options]) ->
  1189     opt(Op, Options);
  1190 opt(_, []) ->
  1191     false.
  1192 
  1193 debug_options(Name, Opts) ->
  1194     case opt(debug, Opts) of
  1195         {ok, Options} -> dbg_options(Name, Options);
  1196         _ -> dbg_options(Name, [])
  1197     end.
  1198 
  1199 dbg_options(Name, []) ->
  1200     Opts =
  1201         case init:get_argument(generic_debug) of
  1202             error ->
  1203                 [];
  1204             _ ->
  1205                 [log, statistics]
  1206         end,
  1207     dbg_opts(Name, Opts);
  1208 dbg_options(Name, Opts) ->
  1209     dbg_opts(Name, Opts).
  1210 
  1211 dbg_opts(Name, Opts) ->
  1212     case catch sys:debug_options(Opts) of
  1213         {'EXIT',_} ->
  1214             format("~p: ignoring erroneous debug options - ~p~n",
  1215                    [Name, Opts]),
  1216             [];
  1217         Dbg ->
  1218             Dbg
  1219     end.
  1220 
  1221 get_proc_name(Pid) when is_pid(Pid) ->
  1222     Pid;
  1223 get_proc_name({local, Name}) ->
  1224     case process_info(self(), registered_name) of
  1225         {registered_name, Name} ->
  1226             Name;
  1227         {registered_name, _Name} ->
  1228             exit(process_not_registered);
  1229         [] ->
  1230             exit(process_not_registered)
  1231     end;
  1232 get_proc_name({global, Name}) ->
  1233     case whereis_name(Name) of
  1234         undefined ->
  1235             exit(process_not_registered_globally);
  1236         Pid when Pid =:= self() ->
  1237             Name;
  1238         _Pid ->
  1239             exit(process_not_registered_globally)
  1240     end.
  1241 
  1242 get_parent() ->
  1243     case get('$ancestors') of
  1244         [Parent | _] when is_pid(Parent)->
  1245             Parent;
  1246         [Parent | _] when is_atom(Parent)->
  1247             name_to_pid(Parent);
  1248         _ ->
  1249             exit(process_was_not_started_by_proc_lib)
  1250     end.
  1251 
  1252 name_to_pid(Name) ->
  1253     case whereis(Name) of
  1254         undefined ->
  1255             case whereis_name(Name) of
  1256                 undefined ->
  1257                     exit(could_not_find_registerd_name);
  1258                 Pid ->
  1259                     Pid
  1260             end;
  1261         Pid ->
  1262             Pid
  1263     end.
  1264 
  1265 whereis_name(Name) ->
  1266     case ets:lookup(global_names, Name) of
  1267     [{_Name, Pid, _Method, _RPid, _Ref}] ->
  1268         if node(Pid) == node() ->
  1269             case is_process_alive(Pid) of
  1270             true  -> Pid;
  1271             false -> undefined
  1272             end;
  1273            true ->
  1274             Pid
  1275         end;
  1276     [] -> undefined
  1277     end.
  1278 
  1279 find_prioritisers(GS2State = #gs2_state { mod = Mod }) ->
  1280     PCall = function_exported_or_default(Mod, 'prioritise_call', 4,
  1281                                          fun (_Msg, _From, _State) -> 0 end),
  1282     PCast = function_exported_or_default(Mod, 'prioritise_cast', 3,
  1283                                          fun (_Msg, _State) -> 0 end),
  1284     PInfo = function_exported_or_default(Mod, 'prioritise_info', 3,
  1285                                          fun (_Msg, _State) -> 0 end),
  1286     GS2State #gs2_state { prioritisers = {PCall, PCast, PInfo} }.
  1287 
  1288 function_exported_or_default(Mod, Fun, Arity, Default) ->
  1289     case erlang:function_exported(Mod, Fun, Arity) of
  1290         true -> case Arity of
  1291                     3 -> fun (Msg, GS2State = #gs2_state { queue = Queue,
  1292                                                            state = State }) ->
  1293                                  Length = priority_queue:len(Queue),
  1294                                  case catch Mod:Fun(Msg, Length, State) of
  1295                                      drop ->
  1296                                          drop;
  1297                                      Res when is_integer(Res) ->
  1298                                          Res;
  1299                                      Err ->
  1300                                          handle_common_termination(Err, Msg, GS2State)
  1301                                  end
  1302                          end;
  1303                     4 -> fun (Msg, From, GS2State = #gs2_state { queue = Queue,
  1304                                                                  state = State }) ->
  1305                                  Length = priority_queue:len(Queue),
  1306                                  case catch Mod:Fun(Msg, From, Length, State) of
  1307                                      Res when is_integer(Res) ->
  1308                                          Res;
  1309                                      Err ->
  1310                                          handle_common_termination(Err, Msg, GS2State)
  1311                                  end
  1312                          end
  1313                 end;
  1314         false -> Default
  1315     end.
  1316 
  1317 %%-----------------------------------------------------------------
  1318 %% Status information
  1319 %%-----------------------------------------------------------------
  1320 format_status(Opt, StatusData) ->
  1321     [PDict, SysState, Parent, Debug,
  1322      #gs2_state{name = Name, state = State, mod = Mod, queue = Queue}] =
  1323         StatusData,
  1324     NameTag = if is_pid(Name) ->
  1325                       pid_to_list(Name);
  1326                  is_atom(Name) ->
  1327                       Name
  1328               end,
  1329     Header = lists:concat(["Status for generic server ", NameTag]),
  1330     Log = sys:get_debug(log, Debug, []),
  1331     Specfic = callback(Mod, format_status, [Opt, [PDict, State]],
  1332                        fun () -> [{data, [{"State", State}]}] end),
  1333     Messages = callback(Mod, format_message_queue, [Opt, Queue],
  1334                         fun () -> priority_queue:to_list(Queue) end),
  1335     [{header, Header},
  1336      {data, [{"Status", SysState},
  1337              {"Parent", Parent},
  1338              {"Logged events", Log},
  1339              {"Queued messages", Messages}]} |
  1340      Specfic].
  1341 
  1342 callback(Mod, FunName, Args, DefaultThunk) ->
  1343     case erlang:function_exported(Mod, FunName, length(Args)) of
  1344         true  -> case catch apply(Mod, FunName, Args) of
  1345                      {'EXIT', _} -> DefaultThunk();
  1346                      Success     -> Success
  1347                  end;
  1348         false -> DefaultThunk()
  1349     end.