1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(gen_fsm).
21
22%%%-----------------------------------------------------------------
23%%%
24%%% This state machine is somewhat more pure than state_lib.  It is
25%%% still based on State dispatching (one function per state), but
26%%% allows a function handle_event to take care of events in all states.
27%%% It's not that pure anymore :(  We also allow synchronized event sending.
28%%%
29%%% If the Parent process terminates the Module:terminate/2
30%%% function is called.
31%%%
32%%% The user module should export:
33%%%
34%%%   init(Args)
35%%%     ==> {ok, StateName, StateData}
36%%%         {ok, StateName, StateData, Timeout}
37%%%         ignore
38%%%         {stop, Reason}
39%%%
40%%%   StateName(Msg, StateData)
41%%%
42%%%    ==> {next_state, NewStateName, NewStateData}
43%%%        {next_state, NewStateName, NewStateData, Timeout}
44%%%        {stop, Reason, NewStateData}
45%%%              Reason = normal | shutdown | Term terminate(State) is called
46%%%
47%%%   StateName(Msg, From, StateData)
48%%%
49%%%    ==> {next_state, NewStateName, NewStateData}
50%%%        {next_state, NewStateName, NewStateData, Timeout}
51%%%        {reply, Reply, NewStateName, NewStateData}
52%%%        {reply, Reply, NewStateName, NewStateData, Timeout}
53%%%        {stop, Reason, NewStateData}
54%%%              Reason = normal | shutdown | Term terminate(State) is called
55%%%
56%%%   handle_event(Msg, StateName, StateData)
57%%%
58%%%    ==> {next_state, NewStateName, NewStateData}
59%%%        {next_state, NewStateName, NewStateData, Timeout}
60%%%        {stop, Reason, Reply, NewStateData}
61%%%        {stop, Reason, NewStateData}
62%%%              Reason = normal | shutdown | Term terminate(State) is called
63%%%
64%%%   handle_sync_event(Msg, From, StateName, StateData)
65%%%
66%%%    ==> {next_state, NewStateName, NewStateData}
67%%%        {next_state, NewStateName, NewStateData, Timeout}
68%%%        {reply, Reply, NewStateName, NewStateData}
69%%%        {reply, Reply, NewStateName, NewStateData, Timeout}
70%%%        {stop, Reason, Reply, NewStateData}
71%%%        {stop, Reason, NewStateData}
72%%%              Reason = normal | shutdown | Term terminate(State) is called
73%%%
74%%%   handle_info(Info, StateName) (e.g. {'EXIT', P, R}, {nodedown, N}, ...
75%%%
76%%%    ==> {next_state, NewStateName, NewStateData}
77%%%        {next_state, NewStateName, NewStateData, Timeout}
78%%%        {stop, Reason, NewStateData}
79%%%              Reason = normal | shutdown | Term terminate(State) is called
80%%%
81%%%   terminate(Reason, StateName, StateData) Let the user module clean up
82%%%        always called when server terminates
83%%%
84%%%    ==> the return value is ignored
85%%%
86%%%
87%%% The work flow (of the fsm) can be described as follows:
88%%%
89%%%   User module                           fsm
90%%%   -----------                          -------
91%%%     start              ----->             start
92%%%     init               <-----              .
93%%%
94%%%                                           loop
95%%%     StateName          <-----              .
96%%%
97%%%     handle_event       <-----              .
98%%%
99%%%     handle__sunc_event <-----              .
100%%%
101%%%     handle_info        <-----              .
102%%%
103%%%     terminate          <-----              .
104%%%
105%%%
106%%% ---------------------------------------------------
107
108-include("logger.hrl").
109
110-export([start/3, start/4,
111	 start_link/3, start_link/4,
112	 stop/1, stop/3,
113	 send_event/2, sync_send_event/2, sync_send_event/3,
114	 send_all_state_event/2,
115	 sync_send_all_state_event/2, sync_send_all_state_event/3,
116	 reply/2,
117	 start_timer/2,send_event_after/2,cancel_timer/1,
118	 enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/7]).
119
120%% Internal exports
121-export([init_it/6,
122	 system_continue/3,
123	 system_terminate/4,
124	 system_code_change/4,
125	 system_get_state/1,
126	 system_replace_state/2,
127	 format_status/2]).
128
129%% logger callback
130-export([format_log/1, format_log/2]).
131
132-deprecated({'_','_', "use the 'gen_statem' module instead"}).
133
134%%% ---------------------------------------------------
135%%% Interface functions.
136%%% ---------------------------------------------------
137
138-callback init(Args :: term()) ->
139    {ok, StateName :: atom(), StateData :: term()} |
140    {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} |
141    {stop, Reason :: term()} | ignore.
142-callback handle_event(Event :: term(), StateName :: atom(),
143                       StateData :: term()) ->
144    {next_state, NextStateName :: atom(), NewStateData :: term()} |
145    {next_state, NextStateName :: atom(), NewStateData :: term(),
146     timeout() | hibernate} |
147    {stop, Reason :: term(), NewStateData :: term()}.
148-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()},
149                            StateName :: atom(), StateData :: term()) ->
150    {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} |
151    {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(),
152     timeout() | hibernate} |
153    {next_state, NextStateName :: atom(), NewStateData :: term()} |
154    {next_state, NextStateName :: atom(), NewStateData :: term(),
155     timeout() | hibernate} |
156    {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} |
157    {stop, Reason :: term(), NewStateData :: term()}.
158-callback handle_info(Info :: term(), StateName :: atom(),
159                      StateData :: term()) ->
160    {next_state, NextStateName :: atom(), NewStateData :: term()} |
161    {next_state, NextStateName :: atom(), NewStateData :: term(),
162     timeout() | hibernate} |
163    {stop, Reason :: normal | term(), NewStateData :: term()}.
164-callback terminate(Reason :: normal | shutdown | {shutdown, term()}
165		    | term(), StateName :: atom(), StateData :: term()) ->
166    term().
167-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(),
168		      StateData :: term(), Extra :: term()) ->
169    {ok, NextStateName :: atom(), NewStateData :: term()}.
170-callback format_status(Opt, StatusData) -> Status when
171      Opt :: 'normal' | 'terminate',
172      StatusData :: [PDict | State],
173      PDict :: [{Key :: term(), Value :: term()}],
174      State :: term(),
175      Status :: term().
176
177-optional_callbacks(
178    [handle_info/3, terminate/3, code_change/4, format_status/2]).
179
180%%% ---------------------------------------------------
181%%% Starts a generic state machine.
182%%% start(Mod, Args, Options)
183%%% start(Name, Mod, Args, Options)
184%%% start_link(Mod, Args, Options)
185%%% start_link(Name, Mod, Args, Options) where:
186%%%    Name ::= {local, atom()} | {global, term()} | {via, atom(), term()}
187%%%    Mod  ::= atom(), callback module implementing the 'real' fsm
188%%%    Args ::= term(), init arguments (to Mod:init/1)
189%%%    Options ::= [{debug, [Flag]}]
190%%%      Flag ::= trace | log | {logfile, File} | statistics | debug
191%%%          (debug == log && statistics)
192%%% Returns: {ok, Pid} |
193%%%          {error, {already_started, Pid}} |
194%%%          {error, Reason}
195%%% ---------------------------------------------------
196start(Mod, Args, Options) ->
197    gen:start(?MODULE, nolink, Mod, Args, Options).
198
199start(Name, Mod, Args, Options) ->
200    gen:start(?MODULE, nolink, Name, Mod, Args, Options).
201
202start_link(Mod, Args, Options) ->
203    gen:start(?MODULE, link, Mod, Args, Options).
204
205start_link(Name, Mod, Args, Options) ->
206    gen:start(?MODULE, link, Name, Mod, Args, Options).
207
208stop(Name) ->
209    gen:stop(Name).
210
211stop(Name, Reason, Timeout) ->
212    gen:stop(Name, Reason, Timeout).
213
214send_event({global, Name}, Event) ->
215    catch global:send(Name, {'$gen_event', Event}),
216    ok;
217send_event({via, Mod, Name}, Event) ->
218    catch Mod:send(Name, {'$gen_event', Event}),
219    ok;
220send_event(Name, Event) ->
221    Name ! {'$gen_event', Event},
222    ok.
223
224sync_send_event(Name, Event) ->
225    case catch gen:call(Name, '$gen_sync_event', Event) of
226	{ok,Res} ->
227	    Res;
228	{'EXIT',Reason} ->
229	    exit({Reason, {?MODULE, sync_send_event, [Name, Event]}})
230    end.
231
232sync_send_event(Name, Event, Timeout) ->
233    case catch gen:call(Name, '$gen_sync_event', Event, Timeout) of
234	{ok,Res} ->
235	    Res;
236	{'EXIT',Reason} ->
237	    exit({Reason, {?MODULE, sync_send_event, [Name, Event, Timeout]}})
238    end.
239
240send_all_state_event({global, Name}, Event) ->
241    catch global:send(Name, {'$gen_all_state_event', Event}),
242    ok;
243send_all_state_event({via, Mod, Name}, Event) ->
244    catch Mod:send(Name, {'$gen_all_state_event', Event}),
245    ok;
246send_all_state_event(Name, Event) ->
247    Name ! {'$gen_all_state_event', Event},
248    ok.
249
250sync_send_all_state_event(Name, Event) ->
251    case catch gen:call(Name, '$gen_sync_all_state_event', Event) of
252	{ok,Res} ->
253	    Res;
254	{'EXIT',Reason} ->
255	    exit({Reason, {?MODULE, sync_send_all_state_event, [Name, Event]}})
256    end.
257
258sync_send_all_state_event(Name, Event, Timeout) ->
259    case catch gen:call(Name, '$gen_sync_all_state_event', Event, Timeout) of
260	{ok,Res} ->
261	    Res;
262	{'EXIT',Reason} ->
263	    exit({Reason, {?MODULE, sync_send_all_state_event,
264			   [Name, Event, Timeout]}})
265    end.
266
267%% Designed to be only callable within one of the callbacks
268%% hence using the self() of this instance of the process.
269%% This is to ensure that timers don't go astray in global
270%% e.g. when straddling a failover, or turn up in a restarted
271%% instance of the process.
272
273%% Returns Ref, sends event {timeout,Ref,Msg} after Time
274%% to the (then) current state.
275start_timer(Time, Msg) ->
276    erlang:start_timer(Time, self(), {'$gen_timer', Msg}).
277
278%% Returns Ref, sends Event after Time to the (then) current state.
279send_event_after(Time, Event) ->
280    erlang:start_timer(Time, self(), {'$gen_event', Event}).
281
282%% Returns the remaining time for the timer if Ref referred to
283%% an active timer/send_event_after, false otherwise.
284cancel_timer(Ref) ->
285    case erlang:cancel_timer(Ref) of
286	false ->
287	    receive {timeout, Ref, _} -> 0
288	    after 0 -> false
289	    end;
290	RemainingTime ->
291	    RemainingTime
292    end.
293
294%% enter_loop/4,5,6
295%% Makes an existing process into a gen_fsm.
296%% The calling process will enter the gen_fsm receive loop and become a
297%% gen_fsm process.
298%% The process *must* have been started using one of the start functions
299%% in proc_lib, see proc_lib(3).
300%% The user is responsible for any initialization of the process,
301%% including registering a name for it.
302enter_loop(Mod, Options, StateName, StateData) ->
303    enter_loop(Mod, Options, StateName, StateData, self(), infinity).
304
305enter_loop(Mod, Options, StateName, StateData, {Scope,_} = ServerName)
306  when Scope == local; Scope == global ->
307    enter_loop(Mod, Options, StateName, StateData, ServerName,infinity);
308enter_loop(Mod, Options, StateName, StateData, {via,_,_} = ServerName) ->
309    enter_loop(Mod, Options, StateName, StateData, ServerName,infinity);
310enter_loop(Mod, Options, StateName, StateData, Timeout) ->
311    enter_loop(Mod, Options, StateName, StateData, self(), Timeout).
312
313enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) ->
314    Name = gen:get_proc_name(ServerName),
315    Parent = gen:get_parent(),
316    Debug = gen:debug_options(Name, Options),
317	HibernateAfterTimeout = gen:hibernate_after(Options),
318    loop(Parent, Name, StateName, StateData, Mod, Timeout, HibernateAfterTimeout, Debug).
319
320%%% ---------------------------------------------------
321%%% Initiate the new process.
322%%% Register the name using the Rfunc function
323%%% Calls the Mod:init/Args function.
324%%% Finally an acknowledge is sent to Parent and the main
325%%% loop is entered.
326%%% ---------------------------------------------------
327init_it(Starter, self, Name, Mod, Args, Options) ->
328    init_it(Starter, self(), Name, Mod, Args, Options);
329init_it(Starter, Parent, Name0, Mod, Args, Options) ->
330    Name = gen:name(Name0),
331    Debug = gen:debug_options(Name, Options),
332	HibernateAfterTimeout = gen:hibernate_after(Options),
333	case catch Mod:init(Args) of
334	{ok, StateName, StateData} ->
335	    proc_lib:init_ack(Starter, {ok, self()}),
336	    loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug);
337	{ok, StateName, StateData, Timeout} ->
338	    proc_lib:init_ack(Starter, {ok, self()}),
339	    loop(Parent, Name, StateName, StateData, Mod, Timeout, HibernateAfterTimeout, Debug);
340	{stop, Reason} ->
341	    gen:unregister_name(Name0),
342	    proc_lib:init_ack(Starter, {error, Reason}),
343	    exit(Reason);
344	ignore ->
345	    gen:unregister_name(Name0),
346	    proc_lib:init_ack(Starter, ignore),
347	    exit(normal);
348	{'EXIT', Reason} ->
349	    gen:unregister_name(Name0),
350	    proc_lib:init_ack(Starter, {error, Reason}),
351	    exit(Reason);
352	Else ->
353	    Error = {bad_return_value, Else},
354	    proc_lib:init_ack(Starter, {error, Error}),
355	    exit(Error)
356    end.
357
358%%-----------------------------------------------------------------
359%% The MAIN loop
360%%-----------------------------------------------------------------
361loop(Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug) ->
362    proc_lib:hibernate(?MODULE,wake_hib,
363		       [Parent, Name, StateName, StateData, Mod, HibernateAfterTimeout,
364			Debug]);
365
366loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug) ->
367	receive
368		Msg ->
369			decode_msg(Msg,Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug, false)
370	after HibernateAfterTimeout ->
371		loop(Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug)
372	end;
373
374loop(Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug) ->
375    Msg = receive
376	      Input ->
377		    Input
378	  after Time ->
379		  {'$gen_event', timeout}
380	  end,
381    decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug, false).
382
383wake_hib(Parent, Name, StateName, StateData, Mod, HibernateAfterTimeout, Debug) ->
384    Msg = receive
385	      Input ->
386		  Input
387	  end,
388    decode_msg(Msg, Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug, true).
389
390decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug, Hib) ->
391    case Msg of
392        {system, From, Req} ->
393	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
394				  [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout], Hib);
395	{'EXIT', Parent, Reason} ->
396	    terminate(
397              Reason, Name, undefined, Msg, Mod, StateName, StateData, Debug);
398	_Msg when Debug =:= [] ->
399	    handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout);
400	_Msg ->
401	    Debug1 = sys:handle_debug(Debug, fun print_event/3,
402				      Name, {in, Msg, StateName}),
403	    handle_msg(Msg, Parent, Name, StateName, StateData,
404		       Mod, Time, HibernateAfterTimeout, Debug1)
405    end.
406
407%%-----------------------------------------------------------------
408%% Callback functions for system messages handling.
409%%-----------------------------------------------------------------
410system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout]) ->
411    loop(Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug).
412
413-spec system_terminate(term(), _, _, [term(),...]) -> no_return().
414
415system_terminate(Reason, _Parent, Debug,
416		 [Name, StateName, StateData, Mod, _Time, _HibernateAfterTimeout]) ->
417    terminate(Reason, Name, undefined, [], Mod, StateName, StateData, Debug).
418
419system_code_change([Name, StateName, StateData, Mod, Time, HibernateAfterTimeout],
420		   _Module, OldVsn, Extra) ->
421    case catch Mod:code_change(OldVsn, StateName, StateData, Extra) of
422	{ok, NewStateName, NewStateData} ->
423	    {ok, [Name, NewStateName, NewStateData, Mod, Time, HibernateAfterTimeout]};
424	Else -> Else
425    end.
426
427system_get_state([_Name, StateName, StateData, _Mod, _Time, _HibernateAfterTimeout]) ->
428    {ok, {StateName, StateData}}.
429
430system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout]) ->
431    Result = {NStateName, NStateData} = StateFun({StateName, StateData}),
432    {ok, Result, [Name, NStateName, NStateData, Mod, Time, HibernateAfterTimeout]}.
433
434%%-----------------------------------------------------------------
435%% Format debug messages.  Print them as the call-back module sees
436%% them, not as the real erlang messages.  Use trace for that.
437%%-----------------------------------------------------------------
438print_event(Dev, {in, Msg, StateName}, Name) ->
439    case Msg of
440	{'$gen_event', Event} ->
441	    io:format(Dev, "*DBG* ~tp got event ~tp in state ~tw~n",
442		      [Name, Event, StateName]);
443	{'$gen_all_state_event', Event} ->
444	    io:format(Dev,
445		      "*DBG* ~tp got all_state_event ~tp in state ~tw~n",
446		      [Name, Event, StateName]);
447	{'$gen_sync_event', {From,_Tag}, Event} ->
448	    io:format(Dev,
449                      "*DBG* ~tp got sync_event ~tp "
450                      "from ~tw in state ~tw~n",
451		      [Name, Event, From, StateName]);
452	{'$gen_sync_all_state_event', {From,_Tag}, Event} ->
453	    io:format(Dev,
454		      "*DBG* ~tp got sync_all_state_event ~tp "
455                      "from ~tw in state ~tw~n",
456		      [Name, Event, From, StateName]);
457	{timeout, Ref, {'$gen_timer', Message}} ->
458	    io:format(Dev,
459		      "*DBG* ~tp got timer ~tp in state ~tw~n",
460		      [Name, {timeout, Ref, Message}, StateName]);
461	{timeout, _Ref, {'$gen_event', Event}} ->
462	    io:format(Dev,
463		      "*DBG* ~tp got timer ~tp in state ~tw~n",
464		      [Name, Event, StateName]);
465	_ ->
466	    io:format(Dev, "*DBG* ~tp got ~tp in state ~tw~n",
467		      [Name, Msg, StateName])
468    end;
469print_event(Dev, {out, Msg, {To,_Tag}, StateName}, Name) ->
470    io:format(Dev, "*DBG* ~tp sent ~tp to ~tw~n"
471	           "      and switched to state ~tw~n",
472	      [Name, Msg, To, StateName]);
473print_event(Dev, {noreply, StateName}, Name) ->
474    io:format(Dev, "*DBG* ~tp switched to state ~tw~n",
475	      [Name, StateName]).
476
477handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout) -> %No debug here
478    From = from(Msg),
479    case catch dispatch(Msg, Mod, StateName, StateData) of
480	{next_state, NStateName, NStateData} ->
481	    loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, []);
482	{next_state, NStateName, NStateData, Time1} ->
483	    loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, []);
484        {reply, Reply, NStateName, NStateData} when From =/= undefined ->
485	    reply(From, Reply),
486	    loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, []);
487        {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined ->
488	    reply(From, Reply),
489	    loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, []);
490	{stop, Reason, NStateData} ->
491	    terminate(Reason, Name, From, Msg, Mod, StateName, NStateData, []);
492	{stop, Reason, Reply, NStateData} when From =/= undefined ->
493	    {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod,
494					   StateName, NStateData, [])),
495	    reply(From, Reply),
496	    exit(R);
497        {'EXIT', {undef, [{Mod, handle_info, [_,_,_], _}|_]}} ->
498            ?LOG_WARNING(#{label=>{gen_fsm,no_handle_info},
499                           module=>Mod,
500                           message=>Msg},
501                         #{domain=>[otp],
502                           report_cb=>fun gen_fsm:format_log/2,
503                         error_logger=>
504                             #{tag=>warning_msg,
505                               report_cb=>fun gen_fsm:format_log/1}}),
506            loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []);
507	{'EXIT', What} ->
508	    terminate(What, Name, From, Msg, Mod, StateName, StateData, []);
509	Reply ->
510	    terminate({bad_return_value, Reply},
511		      Name, From, Msg, Mod, StateName, StateData, [])
512    end.
513
514handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout, Debug) ->
515    From = from(Msg),
516    case catch dispatch(Msg, Mod, StateName, StateData) of
517	{next_state, NStateName, NStateData} ->
518	    Debug1 = sys:handle_debug(Debug, fun print_event/3,
519				      Name, {noreply, NStateName}),
520	    loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, Debug1);
521	{next_state, NStateName, NStateData, Time1} ->
522	    Debug1 = sys:handle_debug(Debug, fun print_event/3,
523				      Name, {noreply, NStateName}),
524	    loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1);
525        {reply, Reply, NStateName, NStateData} when From =/= undefined ->
526	    Debug1 = reply(Name, From, Reply, Debug, NStateName),
527	    loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, Debug1);
528        {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined ->
529	    Debug1 = reply(Name, From, Reply, Debug, NStateName),
530	    loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1);
531	{stop, Reason, NStateData} ->
532	    terminate(
533              Reason, Name, From, Msg, Mod, StateName, NStateData, Debug);
534	{stop, Reason, Reply, NStateData} when From =/= undefined ->
535	    {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod,
536					   StateName, NStateData, Debug)),
537	    _ = reply(Name, From, Reply, Debug, StateName),
538	    exit(R);
539	{'EXIT', What} ->
540	    terminate(What, Name, From, Msg, Mod, StateName, StateData, Debug);
541	Reply ->
542	    terminate({bad_return_value, Reply},
543		      Name, From, Msg, Mod, StateName, StateData, Debug)
544    end.
545
546dispatch({'$gen_event', Event}, Mod, StateName, StateData) ->
547    Mod:StateName(Event, StateData);
548dispatch({'$gen_all_state_event', Event}, Mod, StateName, StateData) ->
549    Mod:handle_event(Event, StateName, StateData);
550dispatch({'$gen_sync_event', From, Event}, Mod, StateName, StateData) ->
551    Mod:StateName(Event, From, StateData);
552dispatch({'$gen_sync_all_state_event', From, Event},
553	 Mod, StateName, StateData) ->
554    Mod:handle_sync_event(Event, From, StateName, StateData);
555dispatch({timeout, Ref, {'$gen_timer', Msg}}, Mod, StateName, StateData) ->
556    Mod:StateName({timeout, Ref, Msg}, StateData);
557dispatch({timeout, _Ref, {'$gen_event', Event}}, Mod, StateName, StateData) ->
558    Mod:StateName(Event, StateData);
559dispatch(Info, Mod, StateName, StateData) ->
560    Mod:handle_info(Info, StateName, StateData).
561
562from({'$gen_sync_event', From, _Event}) -> From;
563from({'$gen_sync_all_state_event', From, _Event}) -> From;
564from(_) -> undefined.
565
566%% Send a reply to the client.
567reply({To, Tag}, Reply) ->
568    catch To ! {Tag, Reply}.
569
570reply(Name, From, Reply, Debug, StateName) ->
571    reply(From, Reply),
572    sys:handle_debug(Debug, fun print_event/3, Name,
573		     {out, Reply, From, StateName}).
574
575%%% ---------------------------------------------------
576%%% Terminate the server.
577%%% ---------------------------------------------------
578
579-spec terminate(term(), _, _, _, atom(), _, _, _) -> no_return().
580
581terminate(Reason, Name, From, Msg, Mod, StateName, StateData, Debug) ->
582    case erlang:function_exported(Mod, terminate, 3) of
583	true ->
584	    case catch Mod:terminate(Reason, StateName, StateData) of
585		{'EXIT', R} ->
586		    FmtStateData = format_status(terminate, Mod, get(), StateData),
587		    error_info(
588                      R, Name, From, Msg, StateName, FmtStateData, Debug),
589		    exit(R);
590		_ ->
591		    ok
592	    end;
593	false ->
594	    ok
595    end,
596    case Reason of
597	normal ->
598	    exit(normal);
599	shutdown ->
600	    exit(shutdown);
601 	{shutdown,_}=Shutdown ->
602 	    exit(Shutdown);
603	_ ->
604	    FmtStateData1 = format_status(terminate, Mod, get(), StateData),
605	    error_info(
606              Reason, Name, From, Msg, StateName, FmtStateData1, Debug),
607	    exit(Reason)
608    end.
609
610error_info(Reason, Name, From, Msg, StateName, StateData, Debug) ->
611    Log = sys:get_log(Debug),
612    ?LOG_ERROR(#{label=>{gen_fsm,terminate},
613                 name=>Name,
614                 last_message=>Msg,
615                 state_name=>StateName,
616                 state_data=>StateData,
617                 log=>Log,
618                 reason=>Reason,
619                 client_info=>client_stacktrace(From)},
620               #{domain=>[otp],
621                 report_cb=>fun gen_fsm:format_log/2,
622                 error_logger=>#{tag=>error,
623                                 report_cb=>fun gen_fsm:format_log/1}}),
624    ok.
625
626client_stacktrace(undefined) ->
627    undefined;
628client_stacktrace({Pid,_Tag}) ->
629    client_stacktrace(Pid);
630client_stacktrace(Pid) when is_pid(Pid), node(Pid) =:= node() ->
631    case process_info(Pid, [current_stacktrace, registered_name]) of
632        undefined ->
633            {Pid,dead};
634        [{current_stacktrace, Stacktrace}, {registered_name, []}]  ->
635            {Pid,{Pid,Stacktrace}};
636        [{current_stacktrace, Stacktrace}, {registered_name, Name}]  ->
637            {Pid,{Name,Stacktrace}}
638    end;
639client_stacktrace(Pid) when is_pid(Pid) ->
640    {Pid,remote}.
641
642
643%% format_log/1 is the report callback used by Logger handler
644%% error_logger only. It is kept for backwards compatibility with
645%% legacy error_logger event handlers. This function must always
646%% return {Format,Args} compatible with the arguments in this module's
647%% calls to error_logger prior to OTP-21.0.
648format_log(Report) ->
649    Depth = error_logger:get_format_depth(),
650    FormatOpts = #{chars_limit => unlimited,
651                   depth => Depth,
652                   single_line => false,
653                   encoding => utf8},
654    format_log_multi(limit_report(Report, Depth), FormatOpts).
655
656limit_report(Report, unlimited) ->
657    Report;
658limit_report(#{label:={gen_fsm,terminate},
659               last_message:=Msg,
660               state_data:=StateData,
661               log:=Log,
662               reason:=Reason,
663               client_info:=ClientInfo}=Report,
664            Depth) ->
665    Report#{last_message=>io_lib:limit_term(Msg, Depth),
666            state_data=>io_lib:limit_term(StateData, Depth),
667            log=>[io_lib:limit_term(L, Depth) || L <- Log],
668            reason=>io_lib:limit_term(Reason, Depth),
669            client_info=>limit_client_report(ClientInfo, Depth)};
670limit_report(#{label:={gen_fsm,no_handle_info},
671               message:=Msg}=Report, Depth) ->
672    Report#{message=>io_lib:limit_term(Msg, Depth)}.
673
674limit_client_report({From,{Name,Stacktrace}}, Depth) ->
675    {From,{Name,io_lib:limit_term(Stacktrace, Depth)}};
676limit_client_report(Client, _) ->
677    Client.
678
679%% format_log/2 is the report callback for any Logger handler, except
680%% error_logger.
681format_log(Report, FormatOpts0) ->
682    Default = #{chars_limit => unlimited,
683                depth => unlimited,
684                single_line => false,
685                encoding => utf8},
686    FormatOpts = maps:merge(Default, FormatOpts0),
687    IoOpts =
688        case FormatOpts of
689            #{chars_limit:=unlimited} ->
690                [];
691            #{chars_limit:=Limit} ->
692                [{chars_limit,Limit}]
693        end,
694    {Format,Args} = format_log_single(Report, FormatOpts),
695    io_lib:format(Format, Args, IoOpts).
696
697format_log_single(#{label:={gen_fsm,terminate},
698                    name:=Name,
699                    last_message:=Msg,
700                    state_name:=StateName,
701                    state_data:=StateData,
702                    log:=Log,
703                    reason:=Reason,
704                    client_info:=ClientInfo},
705                  #{single_line:=true,depth:=Depth}=FormatOpts) ->
706    P = p(FormatOpts),
707    FixedReason = fix_reason(Reason),
708    {ClientFmt,ClientArgs} = format_client_log_single(ClientInfo, P, Depth),
709    Format =
710        lists:append(
711          ["State machine ",P," terminating. Reason: ",P,
712           ". Last event: ",P,
713           ". State: ",P,
714           ". Data: ",P,
715           case Log of
716               [] -> "";
717               _ -> ". Log: "++P
718           end,
719          "."]),
720    Args0 =
721        [Name,FixedReason,get_msg(Msg),StateName,StateData] ++
722        case Log of
723            [] -> [];
724            _ -> [Log]
725        end,
726    Args = case Depth of
727               unlimited ->
728                   Args0;
729               _ ->
730                   lists:flatmap(fun(A) -> [A, Depth] end, Args0)
731           end,
732    {Format++ClientFmt, Args++ClientArgs};
733format_log_single(#{label:={gen_fsm,no_handle_info},
734                    module:=Mod,
735                    message:=Msg},
736                  #{single_line:=true,depth:=Depth}=FormatOpts) ->
737    P = p(FormatOpts),
738    Format = lists:append(["Undefined handle_info in ",P,
739                           ". Unhandled message: ",P,"."]),
740    Args =
741        case Depth of
742            unlimited ->
743                [Mod,Msg];
744            _ ->
745                [Mod,Depth,Msg,Depth]
746        end,
747    {Format,Args};
748format_log_single(Report, FormatOpts) ->
749    format_log_multi(Report, FormatOpts).
750
751format_log_multi(#{label:={gen_fsm,terminate},
752                   name:=Name,
753                   last_message:=Msg,
754                   state_name:=StateName,
755                   state_data:=StateData,
756                   log:=Log,
757                   reason:=Reason,
758                   client_info:=ClientInfo},
759                 #{depth:=Depth}=FormatOpts) ->
760    P = p(FormatOpts),
761    FixedReason = fix_reason(Reason),
762    {ClientFmt,ClientArgs} = format_client_log(ClientInfo, P, Depth),
763    Format =
764        lists:append(
765          ["** State machine ",P," terminating \n"++
766           get_msg_str(Msg, P)++
767           "** When State == ",P,"~n",
768           "**      Data  == ",P,"~n",
769           "** Reason for termination ==~n** ",P,"~n",
770           case Log of
771               [] -> [];
772               _ -> "** Log ==~n**"++P++"~n"
773           end]),
774    Args0 =
775        [Name|get_msg(Msg)] ++
776        [StateName,StateData,FixedReason |
777         case Log of
778             [] -> [];
779             _ -> [Log]
780         end],
781    Args = case Depth of
782               unlimited ->
783                   Args0;
784               _ ->
785                   lists:flatmap(fun(A) -> [A, Depth] end, Args0)
786           end,
787    {Format++ClientFmt,Args++ClientArgs};
788format_log_multi(#{label:={gen_fsm,no_handle_info},
789                   module:=Mod,
790                   message:=Msg},
791                 #{depth:=Depth}=FormatOpts) ->
792    P = p(FormatOpts),
793    Format =
794        "** Undefined handle_info in ~p~n"
795        "** Unhandled message: "++P++"~n",
796    Args =
797        case Depth of
798            unlimited ->
799                [Mod,Msg];
800            _ ->
801                [Mod,Msg,Depth]
802        end,
803    {Format,Args}.
804
805fix_reason({undef,[{M,F,A,L}|MFAs]}=Reason) ->
806    case code:is_loaded(M) of
807        false ->
808            {'module could not be loaded',[{M,F,A,L}|MFAs]};
809        _ ->
810            case erlang:function_exported(M, F, length(A)) of
811                true ->
812                    Reason;
813                false ->
814                    {'function not exported',[{M,F,A,L}|MFAs]}
815            end
816    end;
817fix_reason(Reason) ->
818    Reason.
819
820get_msg_str({'$gen_event', _Event}, P) ->
821    "** Last event in was "++P++"~n";
822get_msg_str({'$gen_sync_event', _From, _Event}, P) ->
823    "** Last sync event in was "++P++" from ~tw~n";
824get_msg_str({'$gen_all_state_event', _Event}, P) ->
825    "** Last event in was "++P++" (for all states)~n";
826get_msg_str({'$gen_sync_all_state_event', _From, _Event}, P) ->
827    "** Last sync event in was "++P++" (for all states) from "++P++"~n";
828get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}, P) ->
829    "** Last timer event in was "++P++"~n";
830get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}, P) ->
831    "** Last timer event in was "++P++"~n";
832get_msg_str(_Msg, P) ->
833    "** Last message in was "++P++"~n".
834
835get_msg({'$gen_event', Event}) -> [Event];
836get_msg({'$gen_sync_event', {From,_Tag}, Event}) -> [Event,From];
837get_msg({'$gen_all_state_event', Event}) -> [Event];
838get_msg({'$gen_sync_all_state_event', {From,_Tag}, Event}) -> [Event,From];
839get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> [{timeout, Ref, Msg}];
840get_msg({timeout, _Ref, {'$gen_event', Event}}) -> [Event];
841get_msg(Msg) -> [Msg].
842
843format_client_log_single(undefined, _, _) ->
844    {"", []};
845format_client_log_single({Pid,dead}, _, _) ->
846    {" Client ~0p is dead.", [Pid]};
847format_client_log_single({Pid,remote}, _, _) ->
848    {" Client ~0p is remote on node ~0p.", [Pid,node(Pid)]};
849format_client_log_single({_Pid,{Name,Stacktrace0}}, P, Depth) ->
850    %% Minimize the stacktrace a bit for single line reports. This is
851    %% hopefully enough to point out the position.
852    Stacktrace = lists:sublist(Stacktrace0, 4),
853    Format = lists:append([" Client ",P," stacktrace: ",P,"."]),
854    Args = case Depth of
855               unlimited ->
856                   [Name, Stacktrace];
857               _ ->
858                   [Name, Depth, Stacktrace, Depth]
859           end,
860    {Format, Args}.
861
862format_client_log(undefined, _, _) ->
863    {"", []};
864format_client_log({Pid,dead}, _, _) ->
865    {"** Client ~p is dead~n", [Pid]};
866format_client_log({Pid,remote}, _, _) ->
867    {"** Client ~p is remote on node ~p~n", [Pid,node(Pid)]};
868format_client_log({_Pid,{Name,Stacktrace}}, P, Depth) ->
869    Format = lists:append(["** Client ",P," stacktrace~n** ",P,"~n"]),
870    Args = case Depth of
871               unlimited ->
872                   [Name, Stacktrace];
873               _ ->
874                   [Name, Depth, Stacktrace, Depth]
875           end,
876    {Format,Args}.
877
878p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) ->
879    "~"++single(Single)++mod(Enc)++p(Depth);
880p(unlimited) ->
881    "p";
882p(_Depth) ->
883    "P".
884
885single(true) -> "0";
886single(false) -> "".
887
888mod(latin1) -> "";
889mod(_) -> "t".
890
891%%-----------------------------------------------------------------
892%% Status information
893%%-----------------------------------------------------------------
894format_status(Opt, StatusData) ->
895    [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time, _HibernateAfterTimeout]] =
896	StatusData,
897    Header = gen:format_status_header("Status for state machine",
898                                      Name),
899    Log = sys:get_log(Debug),
900    Specific =
901        case format_status(Opt, Mod, PDict, StateData) of
902            S when is_list(S) -> S;
903            S -> [S]
904        end,
905    [{header, Header},
906     {data, [{"Status", SysState},
907	     {"Parent", Parent},
908	     {"Logged events", Log},
909	     {"StateName", StateName}]} |
910     Specific].
911
912format_status(Opt, Mod, PDict, State) ->
913    DefStatus = case Opt of
914		    terminate -> State;
915		    _ -> [{data, [{"StateData", State}]}]
916		end,
917    case erlang:function_exported(Mod, format_status, 2) of
918	true ->
919	    case catch Mod:format_status(Opt, [PDict, State]) of
920		{'EXIT', _} -> DefStatus;
921		Else -> Else
922	    end;
923	_ ->
924	    DefStatus
925    end.
926