PageRenderTime 87ms CodeModel.GetById 12ms app.highlight 66ms RepoModel.GetById 1ms app.codeStats 0ms

/src/gen_server2.erl

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