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