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