From edd9607b3bea79be718b774b8c58e623b918eee2 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 15 Jul 2016 16:18:06 +0200 Subject: Fix type and template errors from bugs.erlang.org: ERL-172 and ERL-187 --- lib/stdlib/src/gen_statem.erl | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 23bddafeed..c02e6a1a19 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -219,9 +219,10 @@ OldState :: state(), OldData :: data(), Extra :: term()) -> - {NewCallbackMode :: callback_mode(), + {CallbackMode :: callback_mode(), NewState :: state(), - NewData :: data()}. + NewData :: data()} | + (Reason :: term()). %% Format the callback module state in some sensible that is %% often condensed way. For StatusOption =:= 'normal' the perferred @@ -630,11 +631,11 @@ system_code_change( Result -> Result end of - {NewCallbackMode,NewState,NewData} -> - callback_mode(NewCallbackMode) orelse - error({callback_mode,NewCallbackMode}), + {CallbackMode,NewState,NewData} -> + callback_mode(CallbackMode) orelse + error({callback_mode,CallbackMode}), {ok, - S#{callback_mode := NewCallbackMode, + S#{callback_mode := CallbackMode, state := NewState, data := NewData}}; {ok,_} = Error -> -- cgit v1.2.3 From 30cdfe871577f9622297fb5ed792b117894ef1f2 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 27 Jul 2016 14:41:07 +0200 Subject: Rewrite gen_statem for M:callback_mode/0 --- lib/stdlib/src/gen_statem.erl | 133 +++++++++++++++++++++--------------------- 1 file changed, 68 insertions(+), 65 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index c02e6a1a19..6d7b461ee3 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -24,7 +24,7 @@ [start/3,start/4,start_link/3,start_link/4, stop/1,stop/3, cast/2,call/2,call/3, - enter_loop/5,enter_loop/6,enter_loop/7, + enter_loop/4,enter_loop/5,enter_loop/6, reply/1,reply/2]). %% gen callbacks @@ -63,8 +63,8 @@ {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: - state_name() | % For state callback function StateName/5 - term(). % For state callback function handle_event/5 + state_name() | % For StateName/3 callback functios + term(). % For handle_event/4 callback function -type state_name() :: atom(). @@ -174,28 +174,33 @@ %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. -callback init(Args :: term()) -> - {callback_mode(), state(), data()} | - {callback_mode(), state(), data(), [action()] | action()} | + {ok, state(), data()} | + {ok, state(), data(), [action()] | action()} | 'ignore' | {'stop', Reason :: term()}. -%% Example state callback for callback_mode() =:= state_functions -%% state name 'state_name'. +%% This callback shall return the callback mode of the callback module. %% -%% In this mode all states has to be type state_name() i.e atom(). +%% It is called once after init/0 and code_change/4 but before +%% the first state callback StateName/3 or handle_event/4. +-callback callback_mode() -> callback_mode(). + +%% Example state callback for StateName = 'state_name' +%% when callback_mode() =:= state_functions. +%% +%% In this mode all states has to be of type state_name() i.e atom(). %% -%% Note that state callbacks and only state callbacks have arity 5 -%% and that is intended. +%% Note that the only callbacks that have arity 3 are these +%% StateName/3 callbacks and terminate/3, so the state name +%% 'terminate' is unusable in this mode. -callback state_name( event_type(), EventContent :: term(), Data :: data()) -> state_function_result(). %% -%% State callback for callback_mode() =:= handle_event_function. -%% -%% Note that state callbacks and only state callbacks have arity 5 -%% and that is intended. +%% State callback for all states +%% when callback_mode() =:= handle_event_function. -callback handle_event( event_type(), EventContent :: term(), @@ -219,9 +224,7 @@ OldState :: state(), OldData :: data(), Extra :: term()) -> - {CallbackMode :: callback_mode(), - NewState :: state(), - NewData :: data()} | + {ok, NewState :: state(), NewData :: data()} | (Reason :: term()). %% Format the callback module state in some sensible that is @@ -240,10 +243,13 @@ [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation %% - state_name/3, % Example for callback_mode =:= state_functions: - %% there has to be a StateName/5 callback function for every StateName. + state_name/3, % Example for callback_mode() =:= state_functions: + %% there has to be a StateName/3 callback function + %% for every StateName in your state machine but the state name + %% 'state_name' does of course not have to be used. %% - handle_event/4]). % For callback_mode =:= handle_event_function + handle_event/4 % For callback_mode() =:= handle_event_function + ]). %% Type validation functions callback_mode(CallbackMode) -> @@ -451,43 +457,35 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% the same arguments as you would have returned from init/1 -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data()) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data) -> - enter_loop(Module, Opts, CallbackMode, State, Data, self()). +enter_loop(Module, Opts, State, Data) -> + enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> +enter_loop(Module, Opts, State, Data, Server_or_Actions) -> if is_list(Server_or_Actions) -> - enter_loop( - Module, Opts, CallbackMode, State, Data, - self(), Server_or_Actions); + enter_loop(Module, Opts, State, Data, self(), Server_or_Actions); true -> - enter_loop( - Module, Opts, CallbackMode, State, Data, - Server_or_Actions, []) + enter_loop(Module, Opts, State, Data, Server_or_Actions, []) end. %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> +enter_loop(Module, Opts, State, Data, Server, Actions) -> is_atom(Module) orelse error({atom,Module}), - callback_mode(CallbackMode) orelse error({callback_mode,CallbackMode}), Parent = gen:get_parent(), - enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). + enter(Module, Opts, State, Data, Server, Actions, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -515,7 +513,7 @@ send(Proc, Msg) -> end. %% Here the init_it/6 and enter_loop/5,6,7 functions converge -enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> +enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), @@ -531,7 +529,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> [Actions,{postpone,false}] end, S = #{ - callback_mode => CallbackMode, + callback_mode => undefined, module => Module, name => Name, %% All fields below will be replaced according to the arguments to @@ -569,30 +567,12 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of - {CallbackMode,State,Data} -> - case callback_mode(CallbackMode) of - true -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, [], Parent); - false -> - Error = {callback_mode,CallbackMode}, - proc_lib:init_ack(Starter, {error,Error}), - exit(Error) - end; - {CallbackMode,State,Data,Actions} -> - case callback_mode(CallbackMode) of - true -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, Actions, Parent); - false -> - Error = {callback_mode,CallbackMode}, - proc_lib:init_ack(Starter, {error,Error}), - exit(Error) - end; + {ok,State,Data} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, [], Parent); + {ok,State,Data,Actions} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, Actions, Parent); {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -631,11 +611,9 @@ system_code_change( Result -> Result end of - {CallbackMode,NewState,NewData} -> - callback_mode(CallbackMode) orelse - error({callback_mode,CallbackMode}), + {ok,NewState,NewData} -> {ok, - S#{callback_mode := CallbackMode, + S#{callback_mode := undefined, state := NewState, data := NewData}}; {ok,_} = Error -> @@ -857,6 +835,31 @@ loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> timer := Timer}, loop(Parent, Debug, NewS). +loop_event( + Parent, Debug, + #{callback_mode := undefined, + module := Module} = S, + Events, + State, Data, P, Event, Hibernate) -> + %% Cache the callback_mode() value + case + try Module:callback_mode() + catch + Result -> Result + end + of + CallbackMode -> + case callback_mode(CallbackMode) of + true -> + loop_event( + Parent, Debug, + S#{callback_mode := CallbackMode}, + Events, + State, Data, P, Event, Hibernate); + false -> + error({callback_mode,CallbackMode}) + end + end; loop_event( Parent, Debug, #{callback_mode := CallbackMode, -- cgit v1.2.3 From 3a60545091d3075e23c4a7af8c18b3641bb084e2 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 9 Aug 2016 08:59:51 +0200 Subject: Doc fixes --- lib/stdlib/src/gen_statem.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6d7b461ee3..a39503cb6b 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1295,7 +1295,7 @@ format_status(Opt, PDict, #{module := Module}, State, Data) -> _:_ -> format_status_default( Opt, State, - "Module:format_status/2 crashed") + atom_to_list(Module) ++ ":format_status/2 crashed") end; false -> format_status_default(Opt, State, Data) @@ -1303,10 +1303,10 @@ format_status(Opt, PDict, #{module := Module}, State, Data) -> %% The default Module:format_status/2 format_status_default(Opt, State, Data) -> - SSD = {State,Data}, + StateData = {State,Data}, case Opt of terminate -> - SSD; + StateData; _ -> - [{data,[{"State",SSD}]}] + [{data,[{"State",StateData}]}] end. -- cgit v1.2.3 From a47d47ac92d080c6f8e4fcba1dd8b8575c5a3f96 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 17 Aug 2016 10:42:58 +0200 Subject: Clarify error values --- lib/stdlib/src/gen_statem.erl | 38 +++++++++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 11 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index a39503cb6b..7e4fab5365 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -582,7 +582,7 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, ignore), exit(normal); _ -> - Error = {bad_return_value,Result}, + Error = {bad_return_from_init,Result}, proc_lib:init_ack(Starter, {error,Error}), exit(Error) end. @@ -656,11 +656,11 @@ format_status( print_event(Dev, {in,Event}, {Name,_}) -> io:format( - Dev, "*DBG* ~p received ~s~n", + Dev, "*DBG* ~p receive ~s~n", [Name,event_string(Event)]); print_event(Dev, {out,Reply,{To,_Tag}}, {Name,_}) -> io:format( - Dev, "*DBG* ~p sent ~p to ~p~n", + Dev, "*DBG* ~p send ~p to ~p~n", [Name,Reply,To]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = @@ -992,7 +992,9 @@ loop_event_result( State, Data, P, Event, State, Actions); _ -> terminate( - error, {bad_return_value,Result}, ?STACKTRACE(), + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), Debug, S, [Event|Events], State, Data, P) end. @@ -1029,7 +1031,9 @@ loop_event_actions( Postpone, Hibernate, Timeout, NextEvents); false -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P) end; {next_event,Type,Content} -> @@ -1042,7 +1046,9 @@ loop_event_actions( [{Type,Content}|NextEvents]); false -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P) end; %% Actions that set options @@ -1053,7 +1059,9 @@ loop_event_actions( NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P); postpone -> loop_event_actions( @@ -1067,7 +1075,9 @@ loop_event_actions( Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P); hibernate -> loop_event_actions( @@ -1086,7 +1096,9 @@ loop_event_actions( Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P); infinity -> % Clear timer - it will never trigger loop_event_actions( @@ -1101,7 +1113,9 @@ loop_event_actions( Postpone, Hibernate, NewTimeout, NextEvents); _ -> terminate( - error, {bad_action,Action}, ?STACKTRACE(), + error, + {bad_action_from_state_function,Action}, + ?STACKTRACE(), Debug, S, [Event|Events], State, NewData, P) end; %% @@ -1173,7 +1187,9 @@ do_reply_then_terminate( NewDebug, S, Q, State, Data, P, Rs); _ -> terminate( - error, {bad_action,R}, ?STACKTRACE(), + error, + {bad_reply_action_from_state_function,R}, + ?STACKTRACE(), Debug, S, Q, State, Data, P) end. -- cgit v1.2.3 From b6541d133f166a3f28cc3b2daf14c59024312c60 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 17 Aug 2016 14:29:43 +0200 Subject: Handle exceptions in init/1 and callback_mode/0 --- lib/stdlib/src/gen_statem.erl | 119 +++++++++++++++++++++++++----------------- 1 file changed, 72 insertions(+), 47 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7e4fab5365..eee7d60e9d 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -557,9 +557,15 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> Result -> init_result(Starter, Parent, ServerRef, Module, Result, Opts); Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + Name = gen:get_proc_name(ServerRef), gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + error_info( + Class, Reason, Stacktrace, + #{name => Name, callback_mode => undefined}, + [], [], undefined), + erlang:raise(Class, Reason, Stacktrace) end. %%--------------------------------------------------------------------------- @@ -582,8 +588,14 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, ignore), exit(normal); _ -> + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), Error = {bad_return_from_init,Result}, proc_lib:init_ack(Starter, {error,Error}), + error_info( + error, Error, ?STACKTRACE(), + #{name => Name, callback_mode => undefined}, + [], [], undefined), exit(Error) end. @@ -835,31 +847,6 @@ loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> timer := Timer}, loop(Parent, Debug, NewS). -loop_event( - Parent, Debug, - #{callback_mode := undefined, - module := Module} = S, - Events, - State, Data, P, Event, Hibernate) -> - %% Cache the callback_mode() value - case - try Module:callback_mode() - catch - Result -> Result - end - of - CallbackMode -> - case callback_mode(CallbackMode) of - true -> - loop_event( - Parent, Debug, - S#{callback_mode := CallbackMode}, - Events, - State, Data, P, Event, Hibernate); - false -> - error({callback_mode,CallbackMode}) - end - end; loop_event( Parent, Debug, #{callback_mode := CallbackMode, @@ -878,22 +865,36 @@ loop_event( %% try case CallbackMode of + undefined -> + Module:callback_mode(); state_functions -> - Module:State(Type, Content, Data); + erlang:apply(Module, State, [Type,Content,Data]); handle_event_function -> Module:handle_event(Type, Content, State, Data) - end of + end + of + Result when CallbackMode =:= undefined -> + loop_event_callback_mode( + Parent, Debug, S, Events, State, Data, P, Event, Result); Result -> loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result) catch + Result when CallbackMode =:= undefined -> + loop_event_callback_mode( + Parent, Debug, S, Events, State, Data, P, Event, Result); Result -> loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result); - error:badarg when CallbackMode =:= state_functions -> + error:badarg -> case erlang:get_stacktrace() of - [{erlang,apply,[Module,State,_],_}|Stacktrace] -> - Args = [Type,Content,Data], + [{erlang,apply, + [Module,State,[Type,Content,Data]=Args], + _} + |Stacktrace] + when CallbackMode =:= state_functions -> + %% We get here e.g if apply fails + %% due to State not being an atom terminate( error, {undef_state_function,{Module,State,Args}}, @@ -905,24 +906,29 @@ loop_event( Debug, S, [Event|Events], State, Data, P) end; error:undef -> - %% Process an undef to check for the simple mistake + %% Process undef to check for the simple mistake %% of calling a nonexistent state function + %% to make the undef more precise case erlang:get_stacktrace() of - [{Module,State, - [Type,Content,Data]=Args, - _} + [{Module,callback_mode,[]=Args,_} |Stacktrace] - when CallbackMode =:= state_functions -> + when CallbackMode =:= undefined -> + terminate( + error, + {undef_callback,{Module,callback_mode,Args}}, + Stacktrace, + Debug, S, [Event|Events], State, Data, P); + [{Module,State,[Type,Content,Data]=Args,_} + |Stacktrace] + when CallbackMode =:= state_functions -> terminate( error, {undef_state_function,{Module,State,Args}}, Stacktrace, Debug, S, [Event|Events], State, Data, P); - [{Module,handle_event, - [Type,Content,State,Data]=Args, - _} + [{Module,handle_event,[Type,Content,State,Data]=Args,_} |Stacktrace] - when CallbackMode =:= handle_event_function -> + when CallbackMode =:= handle_event_function -> terminate( error, {undef_state_function,{Module,handle_event,Args}}, @@ -940,6 +946,25 @@ loop_event( Debug, S, [Event|Events], State, Data, P) end. +%% Interpret callback_mode() result +loop_event_callback_mode( + Parent, Debug, S, Events, State, Data, P, Event, CallbackMode) -> + case callback_mode(CallbackMode) of + true -> + Hibernate = false, % We have already GC:ed recently + loop_event( + Parent, Debug, + S#{callback_mode := CallbackMode}, + Events, + State, Data, P, Event, Hibernate); + false -> + terminate( + error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P) + end. + %% Interpret all callback return variants loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result) -> @@ -1208,8 +1233,9 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, Debug, S, Q, P, + C, R, ST, S, Q, P, format_status(terminate, get(), S, State, Data)), + sys:print_log(Debug), erlang:raise(C, R, ST) end, case Reason of @@ -1218,8 +1244,9 @@ terminate( {shutdown,_} -> ok; _ -> error_info( - Class, Reason, Stacktrace, Debug, S, Q, P, - format_status(terminate, get(), S, State, Data)) + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S, State, Data)), + sys:print_log(Debug) end, case Stacktrace of [] -> @@ -1229,7 +1256,7 @@ terminate( end. error_info( - Class, Reason, Stacktrace, Debug, + Class, Reason, Stacktrace, #{name := Name, callback_mode := CallbackMode}, Q, P, FmtData) -> {FixedReason,FixedStacktrace} = @@ -1296,9 +1323,7 @@ error_info( case FixedStacktrace of [] -> []; _ -> [FixedStacktrace] - end), - sys:print_log(Debug), - ok. + end). %% Call Module:format_status/2 or return a default value -- cgit v1.2.3 From 9b1179d8c8c411a245c59fc7092e4a7a98f76663 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 18 Aug 2016 11:18:37 +0200 Subject: Improve sys debug --- lib/stdlib/src/gen_statem.erl | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index eee7d60e9d..3b3477b282 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -666,14 +666,14 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- -print_event(Dev, {in,Event}, {Name,_}) -> +print_event(Dev, {in,Event}, {Name,State}) -> io:format( - Dev, "*DBG* ~p receive ~s~n", - [Name,event_string(Event)]); -print_event(Dev, {out,Reply,{To,_Tag}}, {Name,_}) -> + Dev, "*DBG* ~p receive ~s in state ~p~n", + [Name,event_string(Event),State]); +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> io:format( - Dev, "*DBG* ~p send ~p to ~p~n", - [Name,Reply,To]); + Dev, "*DBG* ~p send ~p to ~p from state ~p~n", + [Name,Reply,To,State]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = case NextState of @@ -1064,8 +1064,10 @@ loop_event_actions( {next_event,Type,Content} -> case event_type(Type) of true -> + NewDebug = + sys_debug(Debug, S, State, {in,{Type,Content}}), loop_event_actions( - Parent, Debug, S, Events, + Parent, NewDebug, S, Events, State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, Timeout, [{Type,Content}|NextEvents]); -- cgit v1.2.3 From f986565050ac30075ef3c0a451bf6dad91c7c446 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 13 Sep 2016 11:15:32 +0200 Subject: Implement call/3 dirty_timeout --- lib/stdlib/src/gen_statem.erl | 110 ++++++++++++++++++++++++++---------------- 1 file changed, 68 insertions(+), 42 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 3b3477b282..46c0e92a9b 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -385,53 +385,79 @@ call(ServerRef, Request) -> -spec call( ServerRef :: server_ref(), Request :: term(), - Timeout :: timeout()) -> + Timeout :: + timeout() | + {'clean_timeout',T :: timeout()} | + {'dirty_timeout',T :: timeout()}) -> Reply :: term(). -call(ServerRef, Request, infinity) -> - try gen:call(ServerRef, '$gen_call', Request, infinity) of - {ok,Reply} -> - Reply - catch - Class:Reason -> - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,infinity]}}, - erlang:get_stacktrace()) - end; call(ServerRef, Request, Timeout) -> - %% Call server through proxy process to dodge any late reply - Ref = make_ref(), - Self = self(), - Pid = spawn( - fun () -> - Self ! - try gen:call( - ServerRef, '$gen_call', Request, Timeout) of - Result -> - {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason,erlang:get_stacktrace()} - end - end), - Mref = monitor(process, Pid), - receive - {Ref,Result} -> - demonitor(Mref, [flush]), - case Result of + case parse_timeout(Timeout) of + {dirty_timeout,T} -> + try gen:call(ServerRef, '$gen_call', Request, T) of {ok,Reply} -> Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end; + {clean_timeout,T} -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) end; - {Ref,Class,Reason,Stacktrace} -> - demonitor(Mref, [flush]), - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - Stacktrace); - {'DOWN',Mref,_,_,Reason} -> - %% There is a theoretical possibility that the - %% proxy process gets killed between try--of and ! - %% so this clause is in case of that - exit(Reason) + Error when is_atom(Error) -> + erlang:error(Error, [ServerRef,Request,Timeout]) + end. + +parse_timeout(Timeout) -> + case Timeout of + {clean_timeout,infinity} -> + {dirty_timeout,infinity}; + {clean_timeout,_} -> + Timeout; + {dirty_timeout,_} -> + Timeout; + {_,_} -> + %% Be nice and throw a badarg for speling errors + badarg; + infinity -> + {dirty_timeout,infinity}; + T -> + {clean_timeout,T} end. %% Reply from a state machine callback to whom awaits in call/2 -- cgit v1.2.3 From 6ee0aefd8a0ea9c165211c42d5244182b5aa9210 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 13 Sep 2016 14:00:04 +0200 Subject: Implement state entry events --- lib/stdlib/src/gen_statem.erl | 208 ++++++++++++++++++++++++++++++------------ 1 file changed, 150 insertions(+), 58 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 46c0e92a9b..7f437404ed 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -53,7 +53,7 @@ action/0]). %% Fix problem for doc build --export_type([transition_option/0]). +-export_type([state_entry_mode/0,transition_option/0]). %%%========================================================================== %%% Interface functions. @@ -72,9 +72,10 @@ -type event_type() :: {'call',From :: from()} | 'cast' | - 'info' | 'timeout' | 'internal'. + 'info' | 'timeout' | 'enter' | 'internal'. -type callback_mode() :: 'state_functions' | 'handle_event_function'. +-type state_entry_mode() :: 'state_entry_events'. -type transition_option() :: postpone() | hibernate() | event_timeout(). @@ -183,7 +184,9 @@ %% %% It is called once after init/0 and code_change/4 but before %% the first state callback StateName/3 or handle_event/4. --callback callback_mode() -> callback_mode(). +-callback callback_mode() -> + callback_mode() | + [callback_mode() | state_entry_mode()]. %% Example state callback for StateName = 'state_name' %% when callback_mode() =:= state_functions. @@ -556,19 +559,27 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> end, S = #{ callback_mode => undefined, + state_entry_events => false, module => Module, name => Name, - %% All fields below will be replaced according to the arguments to + %% The rest of the fields are set from to the arguments to %% loop_event_actions/10 when it finally loops back to loop/3 - state => State, - data => Data, - postponed => P, - hibernate => false, - timer => undefined}, + %% in loop_events_done/8 + %% + %% Marker for initial state, cleared immediately when used + init_state => true + }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), - loop_event_actions( - Parent, NewDebug, S, Events, - State, Data, P, Event, State, NewActions). + case call_callback_mode(S) of + {ok,NewS} -> + loop_event_actions( + Parent, NewDebug, NewS, Events, + State, Data, P, Event, State, NewActions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + NewDebug, S, [Event|Events], State, Data, P) + end. %%%========================================================================== %%% gen callbacks @@ -866,13 +877,93 @@ loop_events( loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> NewS = S#{ - state := State, - data := Data, - postponed := P, - hibernate := Hibernate, - timer := Timer}, + state => State, + data => Data, + postponed => P, + hibernate => Hibernate, + timer => Timer}, loop(Parent, Debug, NewS). + + +parse_callback_mode([], CBMode, SEntry) -> + {CBMode,SEntry}; +parse_callback_mode([H|T], CBMode, SEntry) -> + case callback_mode(H) of + true -> + parse_callback_mode(T, H, SEntry); + false -> + case H of + state_entry_events -> + parse_callback_mode(T, CBMode, true); + _ -> + {undefined,SEntry} + end + end; +parse_callback_mode(_, _CBMode, SEntry) -> + {undefined,SEntry}. + +call_callback_mode(S, CallbackMode) -> + case + parse_callback_mode( + if + is_atom(CallbackMode) -> + [CallbackMode]; + true -> + CallbackMode + end, undefined, false) + of + {undefined,_} -> + {error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()}; + {CBMode,SEntry} -> + {ok, + S#{ + callback_mode := CBMode, + state_entry_events := SEntry}} + end. + +call_callback_mode(#{module := Module} = S) -> + try Module:callback_mode() of + CallbackMode -> + call_callback_mode(S, CallbackMode) + catch + CallbackMode -> + call_callback_mode(S, CallbackMode); + error:undef -> + %% Process undef to check for the simple mistake + %% of calling a nonexistent state function + %% to make the undef more precise + case erlang:get_stacktrace() of + [{Module,callback_mode,[]=Args,_} + |Stacktrace] -> + {error, + {undef_callback,{Module,callback_mode,Args}}, + Stacktrace}; + Stacktrace -> + {error,undef,Stacktrace} + end; + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end. + +loop_event( + Parent, Debug, + #{callback_mode := undefined} = S, + Events, + State, Data, P, Event, Hibernate) -> + %% This happens after code_change/4 + case call_callback_mode(S) of + {ok,NewS} -> + loop_event( + Parent, Debug, NewS, Events, + State, Data, P, Event, Hibernate); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events], State, Data, P) + end; loop_event( Parent, Debug, #{callback_mode := CallbackMode, @@ -891,24 +982,16 @@ loop_event( %% try case CallbackMode of - undefined -> - Module:callback_mode(); state_functions -> erlang:apply(Module, State, [Type,Content,Data]); handle_event_function -> Module:handle_event(Type, Content, State, Data) end of - Result when CallbackMode =:= undefined -> - loop_event_callback_mode( - Parent, Debug, S, Events, State, Data, P, Event, Result); Result -> loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result) catch - Result when CallbackMode =:= undefined -> - loop_event_callback_mode( - Parent, Debug, S, Events, State, Data, P, Event, Result); Result -> loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result); @@ -936,14 +1019,6 @@ loop_event( %% of calling a nonexistent state function %% to make the undef more precise case erlang:get_stacktrace() of - [{Module,callback_mode,[]=Args,_} - |Stacktrace] - when CallbackMode =:= undefined -> - terminate( - error, - {undef_callback,{Module,callback_mode,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); [{Module,State,[Type,Content,Data]=Args,_} |Stacktrace] when CallbackMode =:= state_functions -> @@ -972,25 +1047,6 @@ loop_event( Debug, S, [Event|Events], State, Data, P) end. -%% Interpret callback_mode() result -loop_event_callback_mode( - Parent, Debug, S, Events, State, Data, P, Event, CallbackMode) -> - case callback_mode(CallbackMode) of - true -> - Hibernate = false, % We have already GC:ed recently - loop_event( - Parent, Debug, - S#{callback_mode := CallbackMode}, - Events, - State, Data, P, Event, Hibernate); - false -> - terminate( - error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P) - end. - %% Interpret all callback return variants loop_event_result( Parent, Debug, S, Events, State, Data, P, Event, Result) -> @@ -1174,7 +1230,7 @@ loop_event_actions( %% %% End of actions list loop_event_actions( - Parent, Debug, S, Events, + Parent, Debug, #{state_entry_events := SEEvents} = S, Events, State, NewData, P0, Event, NextState, [], Postpone, Hibernate, Timeout, NextEvents) -> %% @@ -1196,7 +1252,25 @@ loop_event_actions( {lists:reverse(P1, Events),[]} end, %% Place next events first in queue - Q = lists:reverse(NextEvents, Q2), + Q3 = lists:reverse(NextEvents, Q2), + %% State entry events + Q = + case SEEvents of + true -> + %% Generate state entry events + case + (NextState =/= State) + orelse maps:is_key(init_state, S) + of + true -> + %% State change or initial state + [{enter,State}|Q3]; + false -> + Q3 + end; + false -> + Q3 + end, %% NewDebug = sys_debug( @@ -1208,7 +1282,15 @@ loop_event_actions( {consume,Event,NextState} end), loop_events( - Parent, NewDebug, S, Q, NextState, NewData, P, Hibernate, Timeout). + Parent, NewDebug, + %% Avoid infinite loop in initial state with state entry events + case maps:is_key(init_state, S) of + true -> + maps:remove(init_state, S); + false -> + S + end, + Q, NextState, NewData, P, Hibernate, Timeout). %%--------------------------------------------------------------------------- %% Server helpers @@ -1285,7 +1367,9 @@ terminate( error_info( Class, Reason, Stacktrace, - #{name := Name, callback_mode := CallbackMode}, + #{name := Name, + callback_mode := CallbackMode, + state_entry_events := SEEvents}, Q, P, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of @@ -1312,6 +1396,13 @@ error_info( end; _ -> {Reason,Stacktrace} end, + CBMode = + case SEEvents of + true -> + [CallbackMode,state_entry_events]; + false -> + CallbackMode + end, error_logger:format( "** State machine ~p terminating~n" ++ case Q of @@ -1338,8 +1429,9 @@ error_info( [] -> []; [Event|_] -> [Event] end] ++ - [FmtData,Class,FixedReason, - CallbackMode] ++ + [FmtData, + Class,FixedReason, + CBMode] ++ case Q of [_|[_|_] = Events] -> [Events]; _ -> [] -- cgit v1.2.3 From 04d40c5cd18aca449606c19608e8044f593ee99e Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 22 Sep 2016 17:40:47 +0200 Subject: Change state entry events into state enter calls --- lib/stdlib/src/gen_statem.erl | 582 +++++++++++++++++++++++------------------- 1 file changed, 314 insertions(+), 268 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7f437404ed..aedcfc932f 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -47,13 +47,16 @@ %% Type exports for templates -export_type( [event_type/0, - callback_mode/0, + state_name/0, + callback_mode_result/0, state_function_result/0, + state_function_enter_result/0, handle_event_result/0, + handle_event_enter_result/0, action/0]). %% Fix problem for doc build --export_type([state_entry_mode/0,transition_option/0]). +-export_type([transition_option/0]). %%%========================================================================== %%% Interface functions. @@ -72,10 +75,12 @@ -type event_type() :: {'call',From :: from()} | 'cast' | - 'info' | 'timeout' | 'enter' | 'internal'. + 'info' | 'timeout' | 'internal'. +-type callback_mode_result() :: + callback_mode() | [callback_mode() | state_enter()]. -type callback_mode() :: 'state_functions' | 'handle_event_function'. --type state_entry_mode() :: 'state_entry_events'. +-type state_enter() :: 'state_enter'. -type transition_option() :: postpone() | hibernate() | event_timeout(). @@ -109,6 +114,14 @@ 'postpone' | % Set the postpone option {'postpone', Postpone :: postpone()} | %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. + {'next_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + enter_action(). +-type enter_action() :: 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | %% @@ -116,14 +129,7 @@ {'timeout', % Set the event timeout option Time :: event_timeout(), EventContent :: term()} | %% - reply_action() | - %% - %% All 'next_event' events are kept in a list and then - %% inserted at state changes so the first in the - %% action() list is the first to be delivered. - {'next_event', % Insert event as the next to handle - EventType :: event_type(), - EventContent :: term()}. + reply_action(). -type reply_action() :: {'reply', % Reply to a caller From :: from(), Reply :: term()}. @@ -137,6 +143,16 @@ NewData :: data(), Actions :: [action()] | action()} | common_state_callback_result(). +-type state_function_enter_result() :: + {'next_state', % {next_state,NextStateName,NewData,[]} + NextStateName :: state_name(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextStateName :: state_name(), + NewData :: data(), + Actions :: [enter_action()] | enter_action()} | + common_state_callback_result(). + -type handle_event_result() :: {'next_state', % {next_state,NextState,NewData,[]} NextState :: state(), @@ -146,6 +162,16 @@ NewData :: data(), Actions :: [action()] | action()} | common_state_callback_result(). +-type handle_event_enter_result() :: + {'next_state', % {next_state,NextState,NewData,[]} + NextState :: state(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextState :: state(), + NewData :: data(), + Actions :: [enter_action()] | enter_action()} | + common_state_callback_result(). + -type common_state_callback_result() :: 'stop' | % {stop,normal} {'stop', % Stop the server @@ -164,10 +190,10 @@ NewData :: data()} | {'keep_state', % Keep state, change data NewData :: data(), - Actions :: [action()] | action()} | + Actions :: [ActionType] | ActionType} | 'keep_state_and_data' | % {keep_state_and_data,[]} {'keep_state_and_data', % Keep state and data -> only actions - Actions :: [action()] | action()}. + Actions :: [ActionType] | ActionType}. %% The state machine init function. It is called only once and @@ -184,9 +210,7 @@ %% %% It is called once after init/0 and code_change/4 but before %% the first state callback StateName/3 or handle_event/4. --callback callback_mode() -> - callback_mode() | - [callback_mode() | state_entry_mode()]. +-callback callback_mode() -> callback_mode_result(). %% Example state callback for StateName = 'state_name' %% when callback_mode() =:= state_functions. @@ -197,7 +221,11 @@ %% StateName/3 callbacks and terminate/3, so the state name %% 'terminate' is unusable in this mode. -callback state_name( - event_type(), + 'enter', + OldStateName :: state_name(), + Data :: data()) -> + state_function_enter_result(); + (event_type(), EventContent :: term(), Data :: data()) -> state_function_result(). @@ -205,7 +233,12 @@ %% State callback for all states %% when callback_mode() =:= handle_event_function. -callback handle_event( - event_type(), + 'enter', + OldState :: state(), + State :: state(), % Current state + Data :: data()) -> + handle_event_enter_result(); + (event_type(), EventContent :: term(), State :: state(), % Current state Data :: data()) -> @@ -547,7 +580,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), P = Events = [], - Event = {internal,initial_state}, + Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged NewActions = @@ -559,7 +592,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> end, S = #{ callback_mode => undefined, - state_entry_events => false, + state_enter => false, module => Module, name => Name, %% The rest of the fields are set from to the arguments to @@ -886,51 +919,13 @@ loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> -parse_callback_mode([], CBMode, SEntry) -> - {CBMode,SEntry}; -parse_callback_mode([H|T], CBMode, SEntry) -> - case callback_mode(H) of - true -> - parse_callback_mode(T, H, SEntry); - false -> - case H of - state_entry_events -> - parse_callback_mode(T, CBMode, true); - _ -> - {undefined,SEntry} - end - end; -parse_callback_mode(_, _CBMode, SEntry) -> - {undefined,SEntry}. - -call_callback_mode(S, CallbackMode) -> - case - parse_callback_mode( - if - is_atom(CallbackMode) -> - [CallbackMode]; - true -> - CallbackMode - end, undefined, false) - of - {undefined,_} -> - {error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()}; - {CBMode,SEntry} -> - {ok, - S#{ - callback_mode := CBMode, - state_entry_events := SEntry}} - end. - call_callback_mode(#{module := Module} = S) -> try Module:callback_mode() of CallbackMode -> - call_callback_mode(S, CallbackMode) + call_callback_mode_result(S, CallbackMode) catch CallbackMode -> - call_callback_mode(S, CallbackMode); + call_callback_mode_result(S, CallbackMode); error:undef -> %% Process undef to check for the simple mistake %% of calling a nonexistent state function @@ -948,38 +943,57 @@ call_callback_mode(#{module := Module} = S) -> {Class,Reason,erlang:get_stacktrace()} end. -loop_event( - Parent, Debug, +call_callback_mode_result(S, CallbackMode) -> + case + parse_callback_mode( + if + is_atom(CallbackMode) -> + [CallbackMode]; + true -> + CallbackMode + end, undefined, false) + of + {undefined,_} -> + {error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()}; + {CBMode,StateEnter} -> + {ok, + S#{ + callback_mode := CBMode, + state_enter := StateEnter}} + end. + +parse_callback_mode([], CBMode, StateEnter) -> + {CBMode,StateEnter}; +parse_callback_mode([H|T], CBMode, StateEnter) -> + case callback_mode(H) of + true -> + parse_callback_mode(T, H, StateEnter); + false -> + case H of + state_enter -> + parse_callback_mode(T, CBMode, true); + _ -> + {undefined,StateEnter} + end + end; +parse_callback_mode(_, _CBMode, StateEnter) -> + {undefined,StateEnter}. + +call_state_function( #{callback_mode := undefined} = S, - Events, - State, Data, P, Event, Hibernate) -> - %% This happens after code_change/4 + Type, Content, State, Data) -> case call_callback_mode(S) of {ok,NewS} -> - loop_event( - Parent, Debug, NewS, Events, - State, Data, P, Event, Hibernate); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + call_state_function(NewS, Type, Content, State, Data); + Error -> + Error end; -loop_event( - Parent, Debug, +call_state_function( #{callback_mode := CallbackMode, module := Module} = S, - Events, - State, Data, P, {Type,Content} = Event, Hibernate) -> - %% - %% If Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user - %% might depend on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), - %% + Type, Content, State, Data) -> try case CallbackMode of state_functions -> @@ -989,12 +1003,10 @@ loop_event( end of Result -> - loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result) + {ok,Result,S} catch Result -> - loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result); + {ok,Result,S}; error:badarg -> case erlang:get_stacktrace() of [{erlang,apply, @@ -1004,15 +1016,11 @@ loop_event( when CallbackMode =:= state_functions -> %% We get here e.g if apply fails %% due to State not being an atom - terminate( - error, - {undef_state_function,{Module,State,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; Stacktrace -> - terminate( - error, badarg, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + {error,badarg,Stacktrace} end; error:undef -> %% Process undef to check for the simple mistake @@ -1022,34 +1030,54 @@ loop_event( [{Module,State,[Type,Content,Data]=Args,_} |Stacktrace] when CallbackMode =:= state_functions -> - terminate( - error, - {undef_state_function,{Module,State,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; [{Module,handle_event,[Type,Content,State,Data]=Args,_} |Stacktrace] when CallbackMode =:= handle_event_function -> - terminate( - error, - {undef_state_function,{Module,handle_event,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); + {error, + {undef_state_function,{Module,handle_event,Args}}, + Stacktrace}; Stacktrace -> - terminate( - error, undef, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + {error,undef,Stacktrace} end; Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + {Class,Reason,erlang:get_stacktrace()} + end. + +loop_event( + Parent, Debug, S, Events, + State, Data, P, {Type,Content} = Event, Hibernate) -> + %% + %% If Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might depend on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> + {NewData,NextState,Actions} = + parse_event_result( + Parent, Debug, NewS, Events, + State, Data, P, Event, + Result, true), + loop_event_actions( + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions); + {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, Debug, S, [Event|Events], State, Data, P) end. %% Interpret all callback return variants -loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result) -> +parse_event_result( + _Parent, Debug, S, Events, State, Data, P, Event, + Result, AllowStateChange) -> case Result of stop -> terminate( @@ -1073,30 +1101,22 @@ loop_event_result( reply_then_terminate( exit, Reason, ?STACKTRACE(), Debug, S, Q, State, NewData, P, Replies); - {next_state,NextState,NewData} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, []); - {next_state,NextState,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions); + {next_state,State,NewData} -> + {NewData,State,[]}; + {next_state,NextState,NewData} when AllowStateChange -> + {NewData,NextState,[]}; + {next_state,State,NewData,Actions} -> + {NewData,State,Actions}; + {next_state,NextState,NewData,Actions} when AllowStateChange -> + {NewData,NextState,Actions}; {keep_state,NewData} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, State, []); + {NewData,State,[]}; {keep_state,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, State, Actions); + {NewData,State,Actions}; keep_state_and_data -> - loop_event_actions( - Parent, Debug, S, Events, - State, Data, P, Event, State, []); + {Data,State,[]}; {keep_state_and_data,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, Data, P, Event, State, Actions); + {Data,State,Actions}; _ -> terminate( error, @@ -1105,134 +1125,178 @@ loop_event_result( Debug, S, [Event|Events], State, Data, P) end. -loop_event_actions( - Parent, Debug, S, Events, State, NewData, P, Event, NextState, Actions) -> - Postpone = false, % Shall we postpone this event; boolean() +parse_enter_actions(Debug, S, State, Actions, Hibernate, Timeout) -> + Postpone = forbidden, + NextEvents = forbidden, + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, Timeout, Postpone, NextEvents). + +parse_actions(Debug, S, State, Actions) -> + Postpone = false, Hibernate = false, Timeout = undefined, NextEvents = [], - loop_event_actions( - Parent, Debug, S, Events, State, NewData, P, Event, NextState, - if - is_list(Actions) -> - Actions; - true -> - [Actions] - end, - Postpone, Hibernate, Timeout, NextEvents). + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, Timeout, Postpone, NextEvents). %% -%% Process all actions -loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, [Action|Actions], - Postpone, Hibernate, Timeout, NextEvents) -> +parse_actions( + Debug, _S, _State, [], Hibernate, Timeout, Postpone, NextEvents) -> + {ok,Debug,Hibernate,Timeout,Postpone,NextEvents}; +parse_actions( + Debug, S, State, [Action|Actions], + Hibernate, Timeout, Postpone, NextEvents) -> case Action of %% Actual actions {reply,From,Reply} -> case from(From) of true -> NewDebug = do_reply(Debug, S, State, From, Reply), - loop_event_actions( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, Timeout, NextEvents); + parse_actions( + NewDebug, S, State, Actions, + Hibernate, Timeout, Postpone, NextEvents); false -> - terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P) - end; - {next_event,Type,Content} -> - case event_type(Type) of - true -> - NewDebug = - sys_debug(Debug, S, State, {in,{Type,Content}}), - loop_event_actions( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents]); - false -> - terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P) + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} end; %% Actions that set options - {postpone,NewPostpone} when is_boolean(NewPostpone) -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - NewPostpone, Hibernate, Timeout, NextEvents); - {postpone,_} -> - terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); - postpone -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - true, Hibernate, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, NewHibernate, Timeout, NextEvents); + parse_actions( + Debug, S, State, Actions, + NewHibernate, Timeout, Postpone, NextEvents); {hibernate,_} -> - terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; hibernate -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, true, Timeout, NextEvents); + parse_actions( + Debug, S, State, Actions, + true, Timeout, Postpone, NextEvents); {timeout,infinity,_} -> % Clear timer - it will never trigger - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, undefined, NextEvents); + parse_actions( + Debug, S, State, Actions, + Hibernate, undefined, Postpone, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, NewTimeout, NextEvents); + parse_actions( + Debug, S, State, Actions, + Hibernate, NewTimeout, Postpone, NextEvents); {timeout,_,_} -> - terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; infinity -> % Clear timer - it will never trigger - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, undefined, NextEvents); + parse_actions( + Debug, S, State, Actions, + Hibernate, undefined, Postpone, NextEvents); Time when is_integer(Time), Time >= 0 -> NewTimeout = {timeout,Time,Time}, - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, NewTimeout, NextEvents); + parse_actions( + Debug, S, State, Actions, + Hibernate, NewTimeout, Postpone, NextEvents); + {postpone,NewPostpone} + when is_boolean(NewPostpone), Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, Timeout, NewPostpone, NextEvents); + {postpone,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + postpone when Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, Timeout, true, NextEvents); + {next_event,Type,Content} -> + case event_type(Type) of + true when NextEvents =/= forbidden -> + NewDebug = + sys_debug(Debug, S, State, {in,{Type,Content}}), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, Timeout, Postpone, + [{Type,Content}|NextEvents]); + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end. + +loop_event_actions( + Parent, Debug, #{state_enter := StateEnter} = S, Events, + State, NewData, P, Event, NextState, Actions) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,Timeout,Postpone,NextEvents} -> + case + StateEnter andalso + ((NextState =/= State) + orelse maps:is_key(init_state, S)) of + true -> + loop_event_enter( + Parent, NewDebug, S, Events, + State, NewData, P, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents); + false -> + loop_event_result( + Parent, NewDebug, S, Events, + State, NewData, P, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents) + end; + {Class,Reason,Stacktrace} -> terminate( - error, - {bad_action_from_state_function,Action}, - ?STACKTRACE(), + Class, Reason, Stacktrace, Debug, S, [Event|Events], State, NewData, P) - end; -%% -%% End of actions list -loop_event_actions( - Parent, Debug, #{state_entry_events := SEEvents} = S, Events, - State, NewData, P0, Event, NextState, [], - Postpone, Hibernate, Timeout, NextEvents) -> + end. + +loop_event_enter( + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents) -> + case call_state_function(S, enter, State, NextState, NewData) of + {ok,Result,NewS} -> + {NewerData,_,Actions} = + parse_event_result( + Parent, Debug, NewS, Events, + NextState, NewData, P, Event, + Result, false), + loop_event_enter_actions( + Parent, Debug, NewS, Events, + State, NewerData, P, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events], NextState, NewData, P) + end. + +loop_event_enter_actions( + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents, Actions) -> + case + parse_enter_actions(Debug, S, NextState, Actions, Hibernate, Timeout) + of + {ok,NewDebug,NewHibernate,NewTimeout,_,_} -> + loop_event_result( + Parent, NewDebug, S, Events, + State, NewData, P, Event, NextState, + NewHibernate, NewTimeout, Postpone, NextEvents); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events], NextState, NewData, P) + end. + +loop_event_result( + Parent, Debug, S, Events, + State, NewData, P0, Event, NextState, + Hibernate, Timeout, Postpone, NextEvents) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. @@ -1252,44 +1316,21 @@ loop_event_actions( {lists:reverse(P1, Events),[]} end, %% Place next events first in queue - Q3 = lists:reverse(NextEvents, Q2), - %% State entry events - Q = - case SEEvents of - true -> - %% Generate state entry events - case - (NextState =/= State) - orelse maps:is_key(init_state, S) - of - true -> - %% State change or initial state - [{enter,State}|Q3]; - false -> - Q3 - end; - false -> - Q3 - end, + Q = lists:reverse(NextEvents, Q2), %% NewDebug = sys_debug( Debug, S, State, case Postpone of true -> - {postpone,Event,NextState}; + {postpone,Event,State}; false -> - {consume,Event,NextState} + {consume,Event,State} end), loop_events( Parent, NewDebug, %% Avoid infinite loop in initial state with state entry events - case maps:is_key(init_state, S) of - true -> - maps:remove(init_state, S); - false -> - S - end, + maps:remove(init_state, S), Q, NextState, NewData, P, Hibernate, Timeout). %%--------------------------------------------------------------------------- @@ -1369,7 +1410,7 @@ error_info( Class, Reason, Stacktrace, #{name := Name, callback_mode := CallbackMode, - state_entry_events := SEEvents}, + state_enter := StateEnter}, Q, P, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of @@ -1397,9 +1438,9 @@ error_info( _ -> {Reason,Stacktrace} end, CBMode = - case SEEvents of + case StateEnter of true -> - [CallbackMode,state_entry_events]; + [CallbackMode,state_enter]; false -> CallbackMode end, @@ -1471,3 +1512,8 @@ format_status_default(Opt, State, Data) -> _ -> [{data,[{"State",StateData}]}] end. + +listify(Item) when is_list(Item) -> + Item; +listify(Item) -> + [Item]. -- cgit v1.2.3 From 800265f49f912dcf66846b13aa8032bf2f380caf Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 30 Sep 2016 11:17:22 +0200 Subject: Improve docs and types --- lib/stdlib/src/gen_statem.erl | 38 ++++++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 12 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index aedcfc932f..9f5573af86 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -142,7 +142,7 @@ NextStateName :: state_name(), NewData :: data(), Actions :: [action()] | action()} | - common_state_callback_result(). + keep_state_callback_result(). -type state_function_enter_result() :: {'next_state', % {next_state,NextStateName,NewData,[]} NextStateName :: state_name(), @@ -151,7 +151,7 @@ NextStateName :: state_name(), NewData :: data(), Actions :: [enter_action()] | enter_action()} | - common_state_callback_result(). + keep_state_callback_enter_result(). -type handle_event_result() :: {'next_state', % {next_state,NextState,NewData,[]} @@ -161,7 +161,7 @@ NextState :: state(), NewData :: data(), Actions :: [action()] | action()} | - common_state_callback_result(). + keep_state_callback_result(). -type handle_event_enter_result() :: {'next_state', % {next_state,NextState,NewData,[]} NextState :: state(), @@ -170,6 +170,28 @@ NextState :: state(), NewData :: data(), Actions :: [enter_action()] | enter_action()} | + keep_state_callback_enter_result(). + +-type keep_state_callback_result() :: + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [action()] | action()} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [action()] | action()} | + common_state_callback_result(). + +-type keep_state_callback_enter_result() :: + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [enter_action()] | enter_action()} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [enter_action()] | enter_action()} | common_state_callback_result(). -type common_state_callback_result() :: @@ -185,15 +207,7 @@ {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action(), - NewData :: data()} | - {'keep_state', % {keep_state,NewData,[]} - NewData :: data()} | - {'keep_state', % Keep state, change data - NewData :: data(), - Actions :: [ActionType] | ActionType} | - 'keep_state_and_data' | % {keep_state_and_data,[]} - {'keep_state_and_data', % Keep state and data -> only actions - Actions :: [ActionType] | ActionType}. + NewData :: data()}. %% The state machine init function. It is called only once and -- cgit v1.2.3 From 77e175589b0ee3c1a4c94aef3cdcdf54cd84c53c Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 30 Sep 2016 18:00:38 +0200 Subject: Implement state timeouts --- lib/stdlib/src/gen_statem.erl | 464 ++++++++++++++++++++++++++---------------- 1 file changed, 288 insertions(+), 176 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 9f5573af86..bc33be22a2 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -75,7 +75,7 @@ -type event_type() :: {'call',From :: from()} | 'cast' | - 'info' | 'timeout' | 'internal'. + 'info' | 'timeout' | 'state_timeout' | 'internal'. -type callback_mode_result() :: callback_mode() | [callback_mode() | state_enter()]. @@ -95,6 +95,10 @@ %% Generate a ('timeout', EventContent, ...) event after Time %% unless some other event is delivered Time :: timeout(). +-type state_timeout() :: + %% Generate a ('state_timeout', EventContent, ...) event after Time + %% unless the state is changed + Time :: timeout(). -type action() :: %% During a state change: @@ -126,8 +130,10 @@ {'hibernate', Hibernate :: hibernate()} | %% (Timeout :: event_timeout()) | % {timeout,Timeout} - {'timeout', % Set the event timeout option + {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | + {'state_timeout', % Set the state_timeout option + Time :: state_timeout(), EventContent :: term()} | %% reply_action(). -type reply_action() :: @@ -593,7 +599,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - P = Events = [], + Events = [], + P = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged @@ -609,9 +616,12 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> state_enter => false, module => Module, name => Name, + state => State, + data => Data, + postponed => P, %% The rest of the fields are set from to the arguments to - %% loop_event_actions/10 when it finally loops back to loop/3 - %% in loop_events_done/8 + %% loop_event_actions/9 when it finally loops back to loop/3 + %% in loop_events_done/9 %% %% Marker for initial state, cleared immediately when used init_state => true @@ -619,13 +629,14 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> + StateTimer = undefined, loop_event_actions( - Parent, NewDebug, NewS, Events, - State, Data, P, Event, State, NewActions); + Parent, NewDebug, NewS, StateTimer, + Events, Event, State, Data, NewActions); {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, - NewDebug, S, [Event|Events], State, Data, P) + NewDebug, S, [Event|Events]) end. %%%========================================================================== @@ -647,7 +658,9 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> proc_lib:init_ack(Starter, {error,Reason}), error_info( Class, Reason, Stacktrace, - #{name => Name, callback_mode => undefined}, + #{name => Name, + callback_mode => undefined, + state_enter => false}, [], [], undefined), erlang:raise(Class, Reason, Stacktrace) end. @@ -678,7 +691,9 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, {error,Error}), error_info( error, Error, ?STACKTRACE(), - #{name => Name, callback_mode => undefined}, + #{name => Name, + callback_mode => undefined, + state_enter => false}, [], [], undefined), exit(Error) end. @@ -689,12 +704,10 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). -system_terminate( - Reason, _Parent, Debug, - #{state := State, data := Data, postponed := P} = S) -> +system_terminate(Reason, _Parent, Debug, S) -> terminate( exit, Reason, ?STACKTRACE(), - Debug, S, [], State, Data, P). + Debug, S, []). system_code_change( #{module := Module, @@ -731,7 +744,7 @@ system_replace_state( format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P, state := State, data := Data} = S]) -> + #{name := Name, postponed := P} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -740,7 +753,7 @@ format_status( {"Parent",Parent}, {"Logged Events",Log}, {"Postponed",P}]} | - case format_status(Opt, PDict, S, State, Data) of + case format_status(Opt, PDict, S) of L when is_list(L) -> L; T -> [T] end]. @@ -816,7 +829,8 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) -> end. %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{timer := Timer} = S) -> +loop_receive( + Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) -> receive Msg -> case Msg of @@ -827,34 +841,23 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> - #{state := State, data := Data, postponed := P} = S, %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, [EXIT], State, Data, P); - {timeout,Timer,Content} when Timer =/= undefined -> + exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + {timeout,Timer,Content} + when Timer =/= undefined -> loop_receive_result( - Parent, Debug, S, {timeout,Content}); + Parent, Debug, S, StateTimer, + {timeout,Content}); + {timeout,StateTimer,Content} + when StateTimer =/= undefined -> + loop_receive_result( + Parent, Debug, S, undefined, + {state_timeout,Content}); _ -> - %% Cancel Timer if running - case Timer of - undefined -> - ok; - _ -> - case erlang:cancel_timer(Timer) of - TimeLeft when is_integer(TimeLeft) -> - ok; - false -> - receive - {timeout,Timer,_} -> - ok - after 0 -> - ok - end - end - end, + cancel_timer(Timer), Event = case Msg of {'$gen_call',From,Request} -> @@ -864,71 +867,93 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_receive_result(Parent, Debug, S, Event) + loop_receive_result( + Parent, Debug, S, StateTimer, Event) end end. -loop_receive_result( - Parent, Debug, - #{state := State, - data := Data, - postponed := P} = S, - Event) -> - %% The engine state map S is now dismantled - %% and will not be restored until we return to loop/3. - %% - %% The fields 'callback_mode', 'module', and 'name' are still valid. - %% The fields 'state', 'data', and 'postponed' are held in arguments. - %% The fields 'timer' and 'hibernate' will be recalculated. +loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) -> + %% The fields 'timer', 'state_timer' and 'hibernate' + %% are now invalid in state map S - they will be recalculated + %% and restored when we return to loop/3 %% NewDebug = sys_debug(Debug, S, State, {in,Event}), %% Here the queue of not yet handled events is created Events = [], Hibernate = false, - loop_event( - Parent, NewDebug, S, Events, State, Data, P, Event, Hibernate). + loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate). %% Process the event queue, or if it is empty %% loop back to loop/3 to receive a new event loop_events( - Parent, Debug, S, [Event|Events], - State, Data, P, Hibernate, _Timeout) -> + Parent, Debug, S, StateTimeout, + [Event|Events], _Timeout, State, Data, P, Hibernate) -> %% - %% If there was a state timer requested we just ignore that + %% If there was an event timer requested we just ignore that %% since we have events to handle which cancels the timer loop_event( - Parent, Debug, S, Events, State, Data, P, Event, Hibernate); + Parent, Debug, S, StateTimeout, + Events, Event, State, Data, P, Hibernate); +loop_events( + Parent, Debug, S, {state_timeout,Time,EventContent}, + [] = Events, Timeout, State, Data, P, Hibernate) -> + if + Time =:= 0 -> + %% Simulate an immediate timeout + %% so we do not get the timeout message + %% after any received event + %% + %% This faked event will cancel + %& any not yet started event timer + Event = {state_timeout,EventContent}, + StateTimer = undefined, + loop_event( + Parent, Debug, S, StateTimer, + Events, Event, State, Data, P, Hibernate); + true -> + StateTimer = erlang:start_timer(Time, self(), EventContent), + loop_events( + Parent, Debug, S, StateTimer, + Events, Timeout, State, Data, P, Hibernate) + end; loop_events( - Parent, Debug, S, [], - State, Data, P, Hibernate, Timeout) -> + Parent, Debug, S, StateTimer, + [] = Events, Timeout, State, Data, P, Hibernate) -> case Timeout of {timeout,0,EventContent} -> - %% Immediate timeout - simulate it + %% Simulate an immediate timeout %% so we do not get the timeout message %% after any received event + %% + Event = {timeout,EventContent}, loop_event( - Parent, Debug, S, [], - State, Data, P, {timeout,EventContent}, Hibernate); + Parent, Debug, S, StateTimer, + Events, Event, State, Data, P, Hibernate); {timeout,Time,EventContent} -> - %% Actually start a timer Timer = erlang:start_timer(Time, self(), EventContent), loop_events_done( - Parent, Debug, S, Timer, State, Data, P, Hibernate); + Parent, Debug, S, StateTimer, + State, Data, P, Hibernate, Timer); undefined -> - %% No state timeout has been requested + %% No event timeout has been requested Timer = undefined, loop_events_done( - Parent, Debug, S, Timer, State, Data, P, Hibernate) + Parent, Debug, S, StateTimer, + State, Data, P, Hibernate, Timer) end. -%% -loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> + +%% Back to the top +loop_events_done( + Parent, Debug, S, StateTimer, + State, Data, P, Hibernate, Timer) -> NewS = S#{ - state => State, - data => Data, - postponed => P, + state := State, + data := Data, + postponed := P, hibernate => Hibernate, - timer => Timer}, + timer => Timer, + state_timer => StateTimer}, loop(Parent, Debug, NewS). @@ -936,10 +961,10 @@ loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> call_callback_mode(#{module := Module} = S) -> try Module:callback_mode() of CallbackMode -> - call_callback_mode_result(S, CallbackMode) + callback_mode_result(S, CallbackMode) catch CallbackMode -> - call_callback_mode_result(S, CallbackMode); + callback_mode_result(S, CallbackMode); error:undef -> %% Process undef to check for the simple mistake %% of calling a nonexistent state function @@ -957,7 +982,7 @@ call_callback_mode(#{module := Module} = S) -> {Class,Reason,erlang:get_stacktrace()} end. -call_callback_mode_result(S, CallbackMode) -> +callback_mode_result(S, CallbackMode) -> case parse_callback_mode( if @@ -1060,15 +1085,26 @@ call_state_function( {Class,Reason,erlang:get_stacktrace()} end. +%% Update S and continue loop_event( - Parent, Debug, S, Events, - State, Data, P, {Type,Content} = Event, Hibernate) -> + Parent, Debug, S, StateTimer, + Events, Event, State, Data, P, Hibernate) -> + NewS = + S#{ + state := State, + data := Data, + postponed := P}, + loop_event(Parent, Debug, NewS, StateTimer, Events, Event, Hibernate). + +loop_event( + Parent, Debug, #{state := State, data := Data} = S, StateTimer, + Events, {Type,Content} = Event, Hibernate) -> %% %% If Hibernate is true here it can only be %% because it was set from an event action %% and we did not go into hibernation since there %% were events in queue, so we do what the user - %% might depend on i.e collect garbage which + %% might rely on i.e collect garbage which %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), @@ -1076,45 +1112,40 @@ loop_event( {ok,Result,NewS} -> {NewData,NextState,Actions} = parse_event_result( - Parent, Debug, NewS, Events, - State, Data, P, Event, - Result, true), + true, Debug, NewS, Result, + Events, Event, State, Data), loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions); + Parent, Debug, S, StateTimer, + Events, Event, NextState, NewData, Actions); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. %% Interpret all callback return variants parse_event_result( - _Parent, Debug, S, Events, State, Data, P, Event, - Result, AllowStateChange) -> + AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> case Result of stop -> terminate( - exit, normal, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P); + exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P); + exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); {stop,Reason,NewData} -> terminate( exit, Reason, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); + Debug, S#{data := NewData}, [Event|Events]); {stop_and_reply,Reason,Replies} -> Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), - Debug, S, Q, State, Data, P, Replies); + Debug, S, Q, Replies); {stop_and_reply,Reason,Replies,NewData} -> Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), - Debug, S, Q, State, NewData, P, Replies); + Debug, S#{data := NewData}, Q, Replies); {next_state,State,NewData} -> {NewData,State,[]}; {next_state,NextState,NewData} when AllowStateChange -> @@ -1136,31 +1167,35 @@ parse_event_result( error, {bad_return_from_state_function,Result}, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P) + Debug, S, [Event|Events]) end. -parse_enter_actions(Debug, S, State, Actions, Hibernate, Timeout) -> +parse_enter_actions( + Debug, S, State, Actions, + Hibernate, Timeout, StateTimeout) -> Postpone = forbidden, NextEvents = forbidden, parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, Postpone, NextEvents). + Hibernate, Timeout, StateTimeout, Postpone, NextEvents). parse_actions(Debug, S, State, Actions) -> - Postpone = false, Hibernate = false, Timeout = undefined, + StateTimeout = undefined, + Postpone = false, NextEvents = [], parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, Postpone, NextEvents). + Hibernate, Timeout, StateTimeout, Postpone, NextEvents). %% parse_actions( - Debug, _S, _State, [], Hibernate, Timeout, Postpone, NextEvents) -> - {ok,Debug,Hibernate,Timeout,Postpone,NextEvents}; + Debug, _S, _State, [], + Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> + {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents}; parse_actions( Debug, S, State, [Action|Actions], - Hibernate, Timeout, Postpone, NextEvents) -> + Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> case Action of %% Actual actions {reply,From,Reply} -> @@ -1169,7 +1204,8 @@ parse_actions( NewDebug = do_reply(Debug, S, State, From, Reply), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, Postpone, NextEvents); + Hibernate, Timeout, StateTimeout, + Postpone, NextEvents); false -> {error, {bad_action_from_state_function,Action}, @@ -1179,7 +1215,7 @@ parse_actions( {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, - NewHibernate, Timeout, Postpone, NextEvents); + NewHibernate, Timeout, StateTimeout, Postpone, NextEvents); {hibernate,_} -> {error, {bad_action_from_state_function,Action}, @@ -1187,15 +1223,25 @@ parse_actions( hibernate -> parse_actions( Debug, S, State, Actions, - true, Timeout, Postpone, NextEvents); + true, Timeout, StateTimeout, Postpone, NextEvents); + {state_timeout,Time,_} = NewStateTimeout + when is_integer(Time), Time >= 0; + Time =:= infinity -> + parse_actions( + Debug, S, State, Actions, + Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents); + {state_timeout,_,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; {timeout,infinity,_} -> % Clear timer - it will never trigger parse_actions( Debug, S, State, Actions, - Hibernate, undefined, Postpone, NextEvents); + Hibernate, undefined, StateTimeout, Postpone, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, Postpone, NextEvents); + Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); {timeout,_,_} -> {error, {bad_action_from_state_function,Action}, @@ -1203,17 +1249,17 @@ parse_actions( infinity -> % Clear timer - it will never trigger parse_actions( Debug, S, State, Actions, - Hibernate, undefined, Postpone, NextEvents); + Hibernate, undefined, StateTimeout, Postpone, NextEvents); Time when is_integer(Time), Time >= 0 -> NewTimeout = {timeout,Time,Time}, parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, Postpone, NextEvents); + Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, NewPostpone, NextEvents); + Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents); {postpone,_} -> {error, {bad_action_from_state_function,Action}, @@ -1221,7 +1267,7 @@ parse_actions( postpone when Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, true, NextEvents); + Hibernate, Timeout, StateTimeout, true, NextEvents); {next_event,Type,Content} -> case event_type(Type) of true when NextEvents =/= forbidden -> @@ -1229,8 +1275,8 @@ parse_actions( sys_debug(Debug, S, State, {in,{Type,Content}}), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, Postpone, - [{Type,Content}|NextEvents]); + Hibernate, Timeout, StateTimeout, + Postpone, [{Type,Content}|NextEvents]); _ -> {error, {bad_action_from_state_function,Action}, @@ -1243,94 +1289,143 @@ parse_actions( end. loop_event_actions( - Parent, Debug, #{state_enter := StateEnter} = S, Events, - State, NewData, P, Event, NextState, Actions) -> + Parent, Debug, + #{state := State, state_enter := StateEnter} = S, StateTimer, + Events, Event, NextState, NewData, Actions) -> case parse_actions(Debug, S, State, Actions) of - {ok,NewDebug,Hibernate,Timeout,Postpone,NextEvents} -> - case - StateEnter andalso - ((NextState =/= State) - orelse maps:is_key(init_state, S)) of - true -> + {ok,NewDebug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents} -> + if + StateEnter, NextState =/= State -> loop_event_enter( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents); - false -> + Parent, NewDebug, S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents); + StateEnter -> + case maps:is_key(init_state, S) of + true -> + %% Avoid infinite loop in initial state + %% with state entry events + NewS = maps:remove(init_state, S), + loop_event_enter( + Parent, NewDebug, NewS, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, + Postpone, NextEvents); + false -> + loop_event_result( + Parent, NewDebug, S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, + Postpone, NextEvents) + end; + true -> loop_event_result( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents) + Parent, NewDebug, S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents) end; {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, - Debug, S, [Event|Events], State, NewData, P) + Debug, S#{data := NewData}, [Event|Events]) end. loop_event_enter( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents) -> + Parent, Debug, #{state := State} = S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> {NewerData,_,Actions} = parse_event_result( - Parent, Debug, NewS, Events, - NextState, NewData, P, Event, - Result, false), + false, Debug, NewS, Result, + Events, Event, NextState, NewData), loop_event_enter_actions( - Parent, Debug, NewS, Events, - State, NewerData, P, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents, Actions); + Parent, Debug, NewS, StateTimer, + Events, Event, NextState, NewerData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions); {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, - Debug, S, [Event|Events], NextState, NewData, P) + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) end. loop_event_enter_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents, Actions) -> + Parent, Debug, S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions) -> case - parse_enter_actions(Debug, S, NextState, Actions, Hibernate, Timeout) + parse_enter_actions( + Debug, S, NextState, Actions, + Hibernate, Timeout, StateTimeout) of - {ok,NewDebug,NewHibernate,NewTimeout,_,_} -> + {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} -> loop_event_result( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, - NewHibernate, NewTimeout, Postpone, NextEvents); + Parent, NewDebug, S, StateTimer, + Events, Event, NextState, NewData, + NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents); {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, - Debug, S, [Event|Events], NextState, NewData, P) + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) end. loop_event_result( - Parent, Debug, S, Events, - State, NewData, P0, Event, NextState, - Hibernate, Timeout, Postpone, NextEvents) -> + Parent, Debug, + #{state := State, postponed := P_0} = S, StateTimer, + Events, Event, NextState, NewData, + Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - P1 = % Move current event to postponed if Postpone + NewStateTimeout = + case StateTimeout of + {state_timeout,Time,_} -> + %% New timeout -> cancel timer + case StateTimer of + {state_timeout,_,_} -> + ok; + _ -> + cancel_timer(StateTimer) + end, + case Time of + infinity -> + undefined; + _ -> + StateTimeout + end; + undefined when NextState =/= State -> + %% State change -> cancel timer + case StateTimer of + {state_timeout,_,_} -> + ok; + _ -> + cancel_timer(StateTimer) + end, + undefined; + undefined -> + StateTimer + end, + %% + P_1 = % Move current event to postponed if Postpone case Postpone of true -> - [Event|P0]; + [Event|P_0]; false -> - P0 + P_0 end, - {Q2,P} = % Move all postponed events to queue if state change + {Events_1,NewP} = % Move all postponed events to queue if state change if NextState =:= State -> - {Events,P1}; + {Events,P_1}; true -> - {lists:reverse(P1, Events),[]} + {lists:reverse(P_1, Events),[]} end, %% Place next events first in queue - Q = lists:reverse(NextEvents, Q2), + NewEvents = lists:reverse(NextEvents, Events_1), %% NewDebug = sys_debug( @@ -1341,46 +1436,44 @@ loop_event_result( false -> {consume,Event,State} end), + %% loop_events( - Parent, NewDebug, - %% Avoid infinite loop in initial state with state entry events - maps:remove(init_state, S), - Q, NextState, NewData, P, Hibernate, Timeout). + Parent, NewDebug, S, NewStateTimeout, + NewEvents, Timeout, NextState, NewData, NewP, Hibernate). %%--------------------------------------------------------------------------- %% Server helpers reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, Replies) -> + Debug, #{state := State} = S, Q, Replies) -> if is_list(Replies) -> do_reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, Replies); + Debug, S, Q, Replies, State); true -> do_reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, [Replies]) + Debug, S, Q, [Replies], State) end. %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, []) -> - terminate(Class, Reason, Stacktrace, Debug, S, Q, State, Data, P); + Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, [R|Rs]) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> case R of {reply,{_To,_Tag}=From,Reply} -> NewDebug = do_reply(Debug, S, State, From, Reply), do_reply_then_terminate( - Class, Reason, Stacktrace, - NewDebug, S, Q, State, Data, P, Rs); + Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); _ -> terminate( error, {bad_reply_action_from_state_function,R}, ?STACKTRACE(), - Debug, S, Q, State, Data, P) + Debug, S, Q) end. do_reply(Debug, S, State, From, Reply) -> @@ -1390,7 +1483,9 @@ do_reply(Debug, S, State, From, Reply) -> terminate( Class, Reason, Stacktrace, - Debug, #{module := Module} = S, Q, State, Data, P) -> + Debug, + #{module := Module, state := State, data := Data, postponed := P} = S, + Q) -> try Module:terminate(Reason, State, Data) of _ -> ok catch @@ -1399,7 +1494,7 @@ terminate( ST = erlang:get_stacktrace(), error_info( C, R, ST, S, Q, P, - format_status(terminate, get(), S, State, Data)), + format_status(terminate, get(), S)), sys:print_log(Debug), erlang:raise(C, R, ST) end, @@ -1410,7 +1505,7 @@ terminate( _ -> error_info( Class, Reason, Stacktrace, S, Q, P, - format_status(terminate, get(), S, State, Data)), + format_status(terminate, get(), S)), sys:print_log(Debug) end, case Stacktrace of @@ -1502,7 +1597,9 @@ error_info( %% Call Module:format_status/2 or return a default value -format_status(Opt, PDict, #{module := Module}, State, Data) -> +format_status( + Opt, PDict, + #{module := Module, state := State, data := Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -1531,3 +1628,18 @@ listify(Item) when is_list(Item) -> Item; listify(Item) -> [Item]. + +cancel_timer(undefined) -> + ok; +cancel_timer(TRef) -> + case erlang:cancel_timer(TRef) of + TimeLeft when is_integer(TimeLeft) -> + ok; + false -> + receive + {timeout,TRef,_} -> + ok + after 0 -> + ok + end + end. -- cgit v1.2.3 From f4de3f5887be010db178a178e1f20027f3e5d22b Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 12 Oct 2016 17:49:26 +0200 Subject: Use parameterized types --- lib/stdlib/src/gen_statem.erl | 94 ++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 59 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index bc33be22a2..5c750cb93d 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -44,18 +44,20 @@ -export( [wakeup_from_hibernate/3]). -%% Type exports for templates +%% Type exports for templates and callback modules -export_type( [event_type/0, - state_name/0, + init_result/0, callback_mode_result/0, state_function_result/0, - state_function_enter_result/0, handle_event_result/0, - handle_event_enter_result/0, + state_enter_result/1, + event_handler_result/1, + reply_action/0, + enter_action/0, action/0]). -%% Fix problem for doc build +%% Type that is exported just to be documented -export_type([transition_option/0]). %%%========================================================================== @@ -66,7 +68,7 @@ {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: - state_name() | % For StateName/3 callback functios + state_name() | % For StateName/3 callback functions term(). % For handle_event/4 callback function -type state_name() :: atom(). @@ -140,67 +142,45 @@ {'reply', % Reply to a caller From :: from(), Reply :: term()}. --type state_function_result() :: - {'next_state', % {next_state,NextStateName,NewData,[]} - NextStateName :: state_name(), - NewData :: data()} | - {'next_state', % State transition, maybe to the same state - NextStateName :: state_name(), - NewData :: data(), - Actions :: [action()] | action()} | - keep_state_callback_result(). --type state_function_enter_result() :: - {'next_state', % {next_state,NextStateName,NewData,[]} - NextStateName :: state_name(), - NewData :: data()} | - {'next_state', % State transition, maybe to the same state - NextStateName :: state_name(), - NewData :: data(), - Actions :: [enter_action()] | enter_action()} | - keep_state_callback_enter_result(). +-type init_result() :: + {ok, state(), data()} | + {ok, state(), data(), [action()] | action()} | + 'ignore' | + {'stop', Reason :: term()}. +%% Old, not advertised +-type state_function_result() :: + event_handler_result(state_name()). -type handle_event_result() :: + event_handler_result(state()). +%% +-type state_enter_result(StateType) :: {'next_state', % {next_state,NextState,NewData,[]} - NextState :: state(), + State :: StateType, NewData :: data()} | {'next_state', % State transition, maybe to the same state - NextState :: state(), + State :: StateType, NewData :: data(), - Actions :: [action()] | action()} | - keep_state_callback_result(). --type handle_event_enter_result() :: + Actions :: [enter_action()] | enter_action()} | + state_callback_result(enter_action()). +-type event_handler_result(StateType) :: {'next_state', % {next_state,NextState,NewData,[]} - NextState :: state(), + NextState :: StateType, NewData :: data()} | {'next_state', % State transition, maybe to the same state - NextState :: state(), + NextState :: StateType, NewData :: data(), - Actions :: [enter_action()] | enter_action()} | - keep_state_callback_enter_result(). - --type keep_state_callback_result() :: - {'keep_state', % {keep_state,NewData,[]} - NewData :: data()} | - {'keep_state', % Keep state, change data - NewData :: data(), - Actions :: [action()] | action()} | - 'keep_state_and_data' | % {keep_state_and_data,[]} - {'keep_state_and_data', % Keep state and data -> only actions Actions :: [action()] | action()} | - common_state_callback_result(). - --type keep_state_callback_enter_result() :: + state_callback_result(action()). +-type state_callback_result(ActionType) :: {'keep_state', % {keep_state,NewData,[]} NewData :: data()} | {'keep_state', % Keep state, change data NewData :: data(), - Actions :: [enter_action()] | enter_action()} | + Actions :: [ActionType] | ActionType} | 'keep_state_and_data' | % {keep_state_and_data,[]} {'keep_state_and_data', % Keep state and data -> only actions - Actions :: [enter_action()] | enter_action()} | - common_state_callback_result(). - --type common_state_callback_result() :: + Actions :: [ActionType] | ActionType} | 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | @@ -220,11 +200,7 @@ %% the server is not running until this function has returned %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. --callback init(Args :: term()) -> - {ok, state(), data()} | - {ok, state(), data(), [action()] | action()} | - 'ignore' | - {'stop', Reason :: term()}. +-callback init(Args :: term()) -> init_result(). %% This callback shall return the callback mode of the callback module. %% @@ -244,11 +220,11 @@ 'enter', OldStateName :: state_name(), Data :: data()) -> - state_function_enter_result(); + state_enter_result('state_name'); (event_type(), EventContent :: term(), Data :: data()) -> - state_function_result(). + event_handler_result(state_name()). %% %% State callback for all states %% when callback_mode() =:= handle_event_function. @@ -257,12 +233,12 @@ OldState :: state(), State :: state(), % Current state Data :: data()) -> - handle_event_enter_result(); + state_enter_result(state()); (event_type(), EventContent :: term(), State :: state(), % Current state Data :: data()) -> - handle_event_result(). + event_handler_result(state()). %% Clean up before the server terminates. -callback terminate( -- cgit v1.2.3 From 5e2d802e29f0a8f81de297f9a3e3922f2d6cd6c0 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 14 Oct 2016 10:08:49 +0200 Subject: Fix race condition in cancel_timer/1 --- lib/stdlib/src/gen_statem.erl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 5c750cb93d..17d1ebecec 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1609,13 +1609,14 @@ cancel_timer(undefined) -> ok; cancel_timer(TRef) -> case erlang:cancel_timer(TRef) of - TimeLeft when is_integer(TimeLeft) -> - ok; false -> + %% We have to assume that TRef is the ref of a running timer + %% and if so the timer has expired + %% hence we must wait for the timeout message receive {timeout,TRef,_} -> ok - after 0 -> - ok - end + end; + _TimeLeft -> + ok end. -- cgit v1.2.3 From 731cee0b06917f7b34b7e75700cb75605d7ebd32 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Sun, 23 Oct 2016 20:46:49 +0200 Subject: Fix doc and type for state enter calls --- lib/stdlib/src/gen_statem.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 17d1ebecec..a314f43b42 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -154,12 +154,12 @@ -type handle_event_result() :: event_handler_result(state()). %% --type state_enter_result(StateType) :: +-type state_enter_result(State) :: {'next_state', % {next_state,NextState,NewData,[]} - State :: StateType, + State, NewData :: data()} | {'next_state', % State transition, maybe to the same state - State :: StateType, + State, NewData :: data(), Actions :: [enter_action()] | enter_action()} | state_callback_result(enter_action()). @@ -231,9 +231,9 @@ -callback handle_event( 'enter', OldState :: state(), - State :: state(), % Current state + State, % Current state Data :: data()) -> - state_enter_result(state()); + state_enter_result(State); (event_type(), EventContent :: term(), State :: state(), % Current state -- cgit v1.2.3 From 0b4deedf278273205c9dcd2ed5d0b4b4d4d8fb9d Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 20 Oct 2016 22:28:10 +0200 Subject: Rework timeout handling Handling of timers and timeouts has been cleaned up and generalized. Semantic change regarding state timeout zero: Previously if one state caused a state timeout zero and managed to stay in the same state to insert additional timeout zero(s) in the next state callback invocation, then there would be only one timeout zero event. The mindset was that the machine was faster then the timeout zero. This has changed with the mindset that all state callback invocations should be independent, so now the machine will get one state timeout zero event per started state timeout zero. Note that just using zero timeouts is fairly esoteric... --- lib/stdlib/src/gen_statem.erl | 602 +++++++++++++++++++++--------------------- 1 file changed, 302 insertions(+), 300 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index a314f43b42..c81916197c 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -85,7 +85,8 @@ -type state_enter() :: 'state_enter'. -type transition_option() :: - postpone() | hibernate() | event_timeout(). + postpone() | hibernate() | + event_timeout() | state_timeout(). -type postpone() :: %% If 'true' postpone the current event %% and retry it when the state changes (=/=) @@ -108,7 +109,7 @@ %% * All action()s are executed in order of apperance. %% * Postponing the current event is performed %% iff 'postpone' is 'true'. - %% * A state timer is started iff 'timeout' is set. + %% * A state timeout is started iff 'timeout' is set. %% * Pending events are handled or if there are %% no pending events the server goes into receive %% or hibernate (iff 'hibernate' is 'true') @@ -596,8 +597,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> data => Data, postponed => P, %% The rest of the fields are set from to the arguments to - %% loop_event_actions/9 when it finally loops back to loop/3 - %% in loop_events_done/9 + %% loop_event_actions/10 when it finally loops back to loop/3 + %% in loop_events/10 %% %% Marker for initial state, cleared immediately when used init_state => true @@ -605,9 +606,10 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> - StateTimer = undefined, + TimerRefs = #{}, + TimerTypes = #{}, loop_event_actions( - Parent, NewDebug, NewS, StateTimer, + Parent, NewDebug, NewS, TimerRefs, TimerTypes, Events, Event, State, Data, NewActions); {Class,Reason,Stacktrace} -> terminate( @@ -806,7 +808,7 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) -> %% Entry point for wakeup_from_hibernate/3 loop_receive( - Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) -> + Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> receive Msg -> case Msg of @@ -822,18 +824,23 @@ loop_receive( %% but this will stand out in the crash report... terminate( exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); - {timeout,Timer,Content} - when Timer =/= undefined -> - loop_receive_result( - Parent, Debug, S, StateTimer, - {timeout,Content}); - {timeout,StateTimer,Content} - when StateTimer =/= undefined -> - loop_receive_result( - Parent, Debug, S, undefined, - {state_timeout,Content}); + {timeout,TimerRef,TimerMsg} -> + case TimerRefs of + #{TimerRef := TimerType} -> + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + Event); + _ -> + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end; _ -> - cancel_timer(Timer), Event = case Msg of {'$gen_call',From,Request} -> @@ -844,12 +851,15 @@ loop_receive( {info,Msg} end, loop_receive_result( - Parent, Debug, S, StateTimer, Event) + Parent, Debug, S, + TimerRefs, TimerTypes, Event) end end. -loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) -> - %% The fields 'timer', 'state_timer' and 'hibernate' +loop_receive_result( + Parent, Debug, #{state := State} = S, + TimerRefs, TimerTypes, Event) -> + %% The fields 'timer_refs', 'timer_types' and 'hibernate' %% are now invalid in state map S - they will be recalculated %% and restored when we return to loop/3 %% @@ -857,82 +867,197 @@ loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) -> %% Here the queue of not yet handled events is created Events = [], Hibernate = false, - loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate). + loop_event( + Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). -%% Process the event queue, or if it is empty -%% loop back to loop/3 to receive a new event -loop_events( - Parent, Debug, S, StateTimeout, - [Event|Events], _Timeout, State, Data, P, Hibernate) -> +%% Entry point for handling an event, received or enqueued +loop_event( + Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Events, {Type,Content} = Event, Hibernate) -> %% - %% If there was an event timer requested we just ignore that - %% since we have events to handle which cancels the timer - loop_event( - Parent, Debug, S, StateTimeout, - Events, Event, State, Data, P, Hibernate); -loop_events( - Parent, Debug, S, {state_timeout,Time,EventContent}, - [] = Events, Timeout, State, Data, P, Hibernate) -> - if - Time =:= 0 -> - %% Simulate an immediate timeout - %% so we do not get the timeout message - %% after any received event - %% - %% This faked event will cancel - %& any not yet started event timer - Event = {state_timeout,EventContent}, - StateTimer = undefined, - loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate); - true -> - StateTimer = erlang:start_timer(Time, self(), EventContent), - loop_events( - Parent, Debug, S, StateTimer, - Events, Timeout, State, Data, P, Hibernate) - end; -loop_events( - Parent, Debug, S, StateTimer, - [] = Events, Timeout, State, Data, P, Hibernate) -> - case Timeout of - {timeout,0,EventContent} -> - %% Simulate an immediate timeout - %% so we do not get the timeout message - %% after any received event - %% - Event = {timeout,EventContent}, - loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate); - {timeout,Time,EventContent} -> - Timer = erlang:start_timer(Time, self(), EventContent), - loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer); - undefined -> - %% No event timeout has been requested - Timer = undefined, - loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer) + %% If Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> + %% Cancel event timeout + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type( + timeout, TimerRefs, TimerTypes), + {NewData,NextState,Actions} = + parse_event_result( + true, Debug, NewS, Result, + Events, Event, State, Data), + loop_event_actions( + Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Events, Event, NextState, NewData, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) + end. + +loop_event_actions( + Parent, Debug, + #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, Actions) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> + if + StateEnter, NextState =/= State -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + StateEnter -> + case maps:is_key(init_state, S) of + true -> + %% Avoid infinite loop in initial state + %% with state entry events + NewS = maps:remove(init_state, S), + loop_event_enter( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + true -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{data := NewData}, [Event|Events]) + end. + +loop_event_enter( + Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case call_state_function(S, enter, State, NextState, NewData) of + {ok,Result,NewS} -> + {NewerData,_,Actions} = + parse_event_result( + false, Debug, NewS, Result, + Events, Event, NextState, NewData), + loop_event_enter_actions( + Parent, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_enter_actions( + Parent, Debug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + case + parse_enter_actions( + Debug, S, NextState, Actions, + Hibernate, TimeoutsR) + of + {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) end. -%% Back to the top -loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer) -> +loop_event_result( + Parent, Debug, + #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% + {NewDebug,P_1} = % Move current event to postponed if Postpone + case Postpone of + true -> + {sys_debug(Debug, S, State, {postpone,Event,State}), + [Event|P_0]}; + false -> + {sys_debug(Debug, S, State, {consume,Event,State}), + P_0} + end, + {Events_1,NewP,{TimerRefs,TimerTypes}} = + %% Move all postponed events to queue and cancel the + %% state timeout if the state changes + if + NextState =:= State -> + {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + true -> + {lists:reverse(P_1, Events),[], + cancel_timer_by_type( + state_timeout, TimerRefs_0, TimerTypes_0)} + end, + {NewTimerRefs,NewTimerTypes,TimeoutEvents} = + %% Stop and start timers + handle_timers(TimerRefs, TimerTypes, TimeoutsR), + %% Place next events first in reversed queue + NewEventsR = lists:reverse(Events_1, NextEventsR), + %% Append timeout zero events + NewEvents = + lists:reverse( + NewEventsR, + process_timeout_events(TimeoutEvents, NewEventsR)), + %% + loop_events( + Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, + NewEvents, Hibernate, NextState, NewData, NewP). + +%% Loop until out of enqueued events +%% +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [] = _Events, Hibernate, State, Data, P) -> + %% Update S and loop back to loop/3 to receive a new event NewS = S#{ state := State, data := Data, postponed := P, hibernate => Hibernate, - timer => Timer, - state_timer => StateTimer}, - loop(Parent, Debug, NewS). + timer_refs => TimerRefs, + timer_types => TimerTypes}, + loop(Parent, Debug, NewS); +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [Event|Events], Hibernate, State, Data, P) -> + %% Update S and continue with enqueued events + NewS = + S#{ + state := State, + data := Data, + postponed := P}, + loop_event( + Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). + +%%--------------------------------------------------------------------------- +%% Server loop helpers call_callback_mode(#{module := Module} = S) -> try Module:callback_mode() of @@ -996,6 +1121,7 @@ parse_callback_mode([H|T], CBMode, StateEnter) -> parse_callback_mode(_, _CBMode, StateEnter) -> {undefined,StateEnter}. + call_state_function( #{callback_mode := undefined} = S, Type, Content, State, Data) -> @@ -1061,42 +1187,6 @@ call_state_function( {Class,Reason,erlang:get_stacktrace()} end. -%% Update S and continue -loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate) -> - NewS = - S#{ - state := State, - data := Data, - postponed := P}, - loop_event(Parent, Debug, NewS, StateTimer, Events, Event, Hibernate). - -loop_event( - Parent, Debug, #{state := State, data := Data} = S, StateTimer, - Events, {Type,Content} = Event, Hibernate) -> - %% - %% If Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), - case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> - {NewData,NextState,Actions} = - parse_event_result( - true, Debug, NewS, Result, - Events, Event, State, Data), - loop_event_actions( - Parent, Debug, S, StateTimer, - Events, Event, NextState, NewData, Actions); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end. %% Interpret all callback return variants parse_event_result( @@ -1146,32 +1236,32 @@ parse_event_result( Debug, S, [Event|Events]) end. + parse_enter_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout) -> + Hibernate, TimeoutsR) -> Postpone = forbidden, - NextEvents = forbidden, + NextEventsR = forbidden, parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, StateTimeout, Postpone, NextEvents). + Hibernate, TimeoutsR, Postpone, NextEventsR). parse_actions(Debug, S, State, Actions) -> Hibernate = false, - Timeout = undefined, - StateTimeout = undefined, + TimeoutsR = [], Postpone = false, - NextEvents = [], + NextEventsR = [], parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, StateTimeout, Postpone, NextEvents). + Hibernate, TimeoutsR, Postpone, NextEventsR). %% parse_actions( Debug, _S, _State, [], - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents}; + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; parse_actions( Debug, S, State, [Action|Actions], - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> + Hibernate, TimeoutsR, Postpone, NextEventsR) -> case Action of %% Actual actions {reply,From,Reply} -> @@ -1180,8 +1270,7 @@ parse_actions( NewDebug = do_reply(Debug, S, State, From, Reply), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents); + Hibernate, TimeoutsR, Postpone, NextEventsR); false -> {error, {bad_action_from_state_function,Action}, @@ -1191,7 +1280,7 @@ parse_actions( {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, - NewHibernate, Timeout, StateTimeout, Postpone, NextEvents); + NewHibernate, TimeoutsR, Postpone, NextEventsR); {hibernate,_} -> {error, {bad_action_from_state_function,Action}, @@ -1199,43 +1288,44 @@ parse_actions( hibernate -> parse_actions( Debug, S, State, Actions, - true, Timeout, StateTimeout, Postpone, NextEvents); - {state_timeout,Time,_} = NewStateTimeout + true, TimeoutsR, Postpone, NextEventsR); + {state_timeout,Time,_} = StateTimeout when is_integer(Time), Time >= 0; Time =:= infinity -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents); + Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); {state_timeout,_,_} -> {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - {timeout,infinity,_} -> % Clear timer - it will never trigger + {timeout,infinity,_} -> + %% Ignore - timeout will never happen and already cancelled parse_actions( Debug, S, State, Actions, - Hibernate, undefined, StateTimeout, Postpone, NextEvents); - {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> + Hibernate, TimeoutsR, Postpone, NextEventsR); + {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); {timeout,_,_} -> {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - infinity -> % Clear timer - it will never trigger + infinity -> % Ignore - timeout will never happen parse_actions( Debug, S, State, Actions, - Hibernate, undefined, StateTimeout, Postpone, NextEvents); + Hibernate, TimeoutsR, Postpone, NextEventsR); Time when is_integer(Time), Time >= 0 -> - NewTimeout = {timeout,Time,Time}, + Timeout = {timeout,Time,Time}, parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents); + Hibernate, TimeoutsR, NewPostpone, NextEventsR); {postpone,_} -> {error, {bad_action_from_state_function,Action}, @@ -1243,16 +1333,16 @@ parse_actions( postpone when Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout, true, NextEvents); + Hibernate, TimeoutsR, true, NextEventsR); {next_event,Type,Content} -> case event_type(Type) of - true when NextEvents =/= forbidden -> + true when NextEventsR =/= forbidden -> NewDebug = sys_debug(Debug, S, State, {in,{Type,Content}}), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, StateTimeout, - Postpone, [{Type,Content}|NextEvents]); + Hibernate, TimeoutsR, Postpone, + [{Type,Content}|NextEventsR]); _ -> {error, {bad_action_from_state_function,Action}, @@ -1264,158 +1354,59 @@ parse_actions( ?STACKTRACE()} end. -loop_event_actions( - Parent, Debug, - #{state := State, state_enter := StateEnter} = S, StateTimer, - Events, Event, NextState, NewData, Actions) -> - case parse_actions(Debug, S, State, Actions) of - {ok,NewDebug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents} -> - if - StateEnter, NextState =/= State -> - loop_event_enter( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents); - StateEnter -> - case maps:is_key(init_state, S) of - true -> - %% Avoid infinite loop in initial state - %% with state entry events - NewS = maps:remove(init_state, S), - loop_event_enter( - Parent, NewDebug, NewS, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents); - false -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents) - end; - true -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{data := NewData}, [Event|Events]) - end. -loop_event_enter( - Parent, Debug, #{state := State} = S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - case call_state_function(S, enter, State, NextState, NewData) of - {ok,Result,NewS} -> - {NewerData,_,Actions} = - parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData), - loop_event_enter_actions( - Parent, Debug, NewS, StateTimer, - Events, Event, NextState, NewerData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, - [Event|Events]) +%% Stop and start timers as well as create timeout zero events +%% +handle_timers(TimerRefs, TimerTypes, TimeoutsR) -> + Seen = #{}, + TimeoutEvents = [], + handle_timers(TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents). +%% +handle_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,TimeoutEvents}; +handle_timers(TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + {TimerType,Time,TimerMsg} = Timeout, + case Seen of + #{TimerType := _} -> + handle_timers( + TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + #{} -> + NewSeen = Seen#{TimerType => true}, + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), + case Time of + 0 -> + TimeoutEvent = {TimerType,TimerMsg}, + handle_timers( + NewTimerRefs, NewTimerTypes, + TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); + infinity -> + %% Ignore - timer will never fire + handle_timers( + NewTimerRefs, NewTimerTypes, + TimeoutsR, NewSeen, TimeoutEvents); + _ -> + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + handle_timers( + NewTimerRefs#{TimerRef => TimerType}, + NewTimerTypes#{TimerType => TimerRef}, + TimeoutsR, NewSeen, TimeoutEvents) + end end. -loop_event_enter_actions( - Parent, Debug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions) -> - case - parse_enter_actions( - Debug, S, NextState, Actions, - Hibernate, Timeout, StateTimeout) - of - {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, - [Event|Events]) - end. -loop_event_result( - Parent, Debug, - #{state := State, postponed := P_0} = S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - %% - %% All options have been collected and next_events are buffered. - %% Do the actual state transition. - %% - NewStateTimeout = - case StateTimeout of - {state_timeout,Time,_} -> - %% New timeout -> cancel timer - case StateTimer of - {state_timeout,_,_} -> - ok; - _ -> - cancel_timer(StateTimer) - end, - case Time of - infinity -> - undefined; - _ -> - StateTimeout - end; - undefined when NextState =/= State -> - %% State change -> cancel timer - case StateTimer of - {state_timeout,_,_} -> - ok; - _ -> - cancel_timer(StateTimer) - end, - undefined; - undefined -> - StateTimer - end, - %% - P_1 = % Move current event to postponed if Postpone - case Postpone of - true -> - [Event|P_0]; - false -> - P_0 - end, - {Events_1,NewP} = % Move all postponed events to queue if state change - if - NextState =:= State -> - {Events,P_1}; - true -> - {lists:reverse(P_1, Events),[]} - end, - %% Place next events first in queue - NewEvents = lists:reverse(NextEvents, Events_1), - %% - NewDebug = - sys_debug( - Debug, S, State, - case Postpone of - true -> - {postpone,Event,State}; - false -> - {consume,Event,State} - end), - %% - loop_events( - Parent, NewDebug, S, NewStateTimeout, - NewEvents, Timeout, NextState, NewData, NewP, Hibernate). +%% Keep an event timeout event if it is the only event so far +process_timeout_events([], _Es) -> + []; +process_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> + [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent])]; +process_timeout_events([{timeout,_}|TimeoutEvents], Es) -> + %% Ignore event timeout since there are other events + process_timeout_events(TimeoutEvents, Es); +process_timeout_events([TimeoutEvent|TimeoutEvents], Es) -> + [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent|Es])]. + + %%--------------------------------------------------------------------------- %% Server helpers @@ -1605,8 +1596,19 @@ listify(Item) when is_list(Item) -> listify(Item) -> [Item]. -cancel_timer(undefined) -> - ok; +%% Cancel timer if running, otherwise no op +cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> + case TimerTypes of + #{TimerType := TimerRef} -> + cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes)}; + #{} -> + {TimerRefs,TimerTypes} + end. + +%%cancel_timer(undefined) -> +%% ok; cancel_timer(TRef) -> case erlang:cancel_timer(TRef) of false -> -- cgit v1.2.3 From 32485c0499a0893b4fb69c6e26d91b4303cb1cba Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 21 Oct 2016 23:36:26 +0200 Subject: Optimize event timeout Do not start an event timer unless there are no enqueued events. --- lib/stdlib/src/gen_statem.erl | 116 +++++++++++++++++++++++++++--------------- 1 file changed, 74 insertions(+), 42 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index c81916197c..c9f8ec1881 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1001,7 +1001,7 @@ loop_event_result( {sys_debug(Debug, S, State, {consume,Event,State}), P_0} end, - {Events_1,NewP,{TimerRefs,TimerTypes}} = + {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = %% Move all postponed events to queue and cancel the %% state timeout if the state changes if @@ -1012,17 +1012,16 @@ loop_event_result( cancel_timer_by_type( state_timeout, TimerRefs_0, TimerTypes_0)} end, - {NewTimerRefs,NewTimerTypes,TimeoutEvents} = - %% Stop and start timers - handle_timers(TimerRefs, TimerTypes, TimeoutsR), - %% Place next events first in reversed queue - NewEventsR = lists:reverse(Events_1, NextEventsR), - %% Append timeout zero events - NewEvents = - lists:reverse( - NewEventsR, - process_timeout_events(TimeoutEvents, NewEventsR)), - %% + {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + %% Stop and start timers non-event timers + parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + %% Place next events last in reversed queue + Events_2R = lists:reverse(Events_1, NextEventsR), + %% Enqueue immediate timeout events and start event timer + {NewTimerRefs,NewTimerTypes,Events_3R} = + process_timeout_events( + TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), + NewEvents = lists:reverse(Events_3R), loop_events( Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, NewEvents, Hibernate, NextState, NewData, NewP). @@ -1356,55 +1355,88 @@ parse_actions( %% Stop and start timers as well as create timeout zero events +%% and pending event timer %% -handle_timers(TimerRefs, TimerTypes, TimeoutsR) -> - Seen = #{}, - TimeoutEvents = [], - handle_timers(TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents). +%% Stop and start timers non-event timers +parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). %% -handle_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> +parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> {TimerRefs,TimerTypes,TimeoutEvents}; -handle_timers(TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> +parse_timers( + TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> {TimerType,Time,TimerMsg} = Timeout, case Seen of #{TimerType := _} -> - handle_timers( + %% Type seen before - ignore + parse_timers( TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); #{} -> + %% Unseen type - handle NewSeen = Seen#{TimerType => true}, + %% Cancel any running timer {NewTimerRefs,NewTimerTypes} = cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), - case Time of - 0 -> - TimeoutEvent = {TimerType,TimerMsg}, - handle_timers( - NewTimerRefs, NewTimerTypes, - TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); - infinity -> + if + Time =:= infinity -> %% Ignore - timer will never fire - handle_timers( - NewTimerRefs, NewTimerTypes, - TimeoutsR, NewSeen, TimeoutEvents); - _ -> + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, TimeoutEvents); + TimerType =:= timeout -> + %% Handle event timer later + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [Timeout|TimeoutEvents]); + Time =:= 0 -> + %% Handle zero time timeouts later + TimeoutEvent = {TimerType,TimerMsg}, + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [TimeoutEvent|TimeoutEvents]); + true -> + %% Start a new timer TimerRef = erlang:start_timer(Time, self(), TimerMsg), - handle_timers( + parse_timers( NewTimerRefs#{TimerRef => TimerType}, NewTimerTypes#{TimerType => TimerRef}, TimeoutsR, NewSeen, TimeoutEvents) end end. - -%% Keep an event timeout event if it is the only event so far -process_timeout_events([], _Es) -> - []; -process_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> - [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent])]; -process_timeout_events([{timeout,_}|TimeoutEvents], Es) -> - %% Ignore event timeout since there are other events - process_timeout_events(TimeoutEvents, Es); -process_timeout_events([TimeoutEvent|TimeoutEvents], Es) -> - [TimeoutEvent|process_timeout_events(TimeoutEvents, [TimeoutEvent|Es])]. +%% Enqueue immediate timeout events and start event timer +process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> + {TimerRefs, TimerTypes, EventsR}; +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,0,TimerMsg}|TimeoutEvents], []) -> + %% No enqueued events - insert a timeout zero event + TimeoutEvent = {timeout,TimerMsg}, + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent]); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,Time,TimerMsg}], []) -> + %% No enqueued events - start event timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + process_timeout_events( + TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, + [], []); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> + %% There will be some other event so optimize by not starting + %% an event timer to just have to cancel it again + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, EventsR); +process_timeout_events( + TimerRefs, TimerTypes, + [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent|EventsR]). -- cgit v1.2.3 From 167c57b1472746d01ff10f759e18e17bf5fb4fb6 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 26 Oct 2016 10:38:13 +0200 Subject: Log terminate to sys debug --- lib/stdlib/src/gen_statem.erl | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index c9f8ec1881..018aca90e6 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -749,6 +749,10 @@ print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> io:format( Dev, "*DBG* ~p send ~p to ~p from state ~p~n", [Name,Reply,To,State]); +print_event(Dev, {terminate,Reason}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p terminate ~p in state ~p~n", + [Name,Reason,State]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = case NextState of @@ -1497,16 +1501,20 @@ terminate( sys:print_log(Debug), erlang:raise(C, R, ST) end, - case Reason of - normal -> ok; - shutdown -> ok; - {shutdown,_} -> ok; - _ -> - error_info( - Class, Reason, Stacktrace, S, Q, P, - format_status(terminate, get(), S)), - sys:print_log(Debug) - end, + _ = + case Reason of + normal -> + sys_debug(Debug, S, State, {terminate,Reason}); + shutdown -> + sys_debug(Debug, S, State, {terminate,Reason}); + {shutdown,_} -> + sys_debug(Debug, S, State, {terminate,Reason}); + _ -> + error_info( + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug) + end, case Stacktrace of [] -> erlang:Class(Reason); -- cgit v1.2.3 From 35985299ae5414fb448d9961071f722ce209f0b6 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 20 Jan 2017 16:22:15 +0100 Subject: Change arity of type to init_result/1 --- lib/stdlib/src/gen_statem.erl | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 018aca90e6..b6b02a47bc 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016. All Rights Reserved. +%% Copyright Ericsson AB 2016-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,15 +47,17 @@ %% Type exports for templates and callback modules -export_type( [event_type/0, - init_result/0, callback_mode_result/0, - state_function_result/0, - handle_event_result/0, + init_result/1, state_enter_result/1, event_handler_result/1, reply_action/0, enter_action/0, action/0]). +%% Old types, not advertised +-export_type( + [state_function_result/0, + handle_event_result/0]). %% Type that is exported just to be documented -export_type([transition_option/0]). @@ -143,9 +145,10 @@ {'reply', % Reply to a caller From :: from(), Reply :: term()}. --type init_result() :: - {ok, state(), data()} | - {ok, state(), data(), [action()] | action()} | +-type init_result(StateType) :: + {ok, State :: StateType, Data :: data()} | + {ok, State :: StateType, Data :: data(), + Actions :: [action()] | action()} | 'ignore' | {'stop', Reason :: term()}. @@ -201,7 +204,7 @@ %% the server is not running until this function has returned %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. --callback init(Args :: term()) -> init_result(). +-callback init(Args :: term()) -> init_result(state()). %% This callback shall return the callback mode of the callback module. %% -- cgit v1.2.3 From 60f8840e8e62dece4a7e2e58f0d9e487c4e8018f Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 23 Jan 2017 10:43:56 +0100 Subject: Correct type checking function for action {next_event,,} --- lib/stdlib/src/gen_statem.erl | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index b6b02a47bc..4b5f5f676c 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -307,12 +307,16 @@ event_type({call,From}) -> from(From); event_type(Type) -> case Type of + {call,From} -> + from(From); cast -> true; info -> true; timeout -> true; + state_timeout -> + true; internal -> true; _ -> -- cgit v1.2.3 From 85e9fed232a6d89e3659cabbb2169cf3e21127e3 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 24 Jan 2017 14:15:26 +0100 Subject: Implement repeat_state and repeat_state_and_data --- lib/stdlib/src/gen_statem.erl | 116 ++++++++++++++++++++++++------------------ 1 file changed, 66 insertions(+), 50 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 4b5f5f676c..5de31ebfe0 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -185,12 +185,23 @@ 'keep_state_and_data' | % {keep_state_and_data,[]} {'keep_state_and_data', % Keep state and data -> only actions Actions :: [ActionType] | ActionType} | + %% + {'repeat_state', % {repeat_state,NewData,[]} + NewData :: data()} | + {'repeat_state', % Repeat state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'repeat_state_and_data' | % {repeat_state_and_data,[]} + {'repeat_state_and_data', % Repeat state and data -> only actions + Actions :: [ActionType] | ActionType} | + %% 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | {'stop', % Stop the server Reason :: term(), NewData :: data()} | + %% {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action()} | @@ -602,13 +613,10 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> name => Name, state => State, data => Data, - postponed => P, + postponed => P %% The rest of the fields are set from to the arguments to - %% loop_event_actions/10 when it finally loops back to loop/3 + %% loop_event_actions/11 when it finally loops back to loop/3 %% in loop_events/10 - %% - %% Marker for initial state, cleared immediately when used - init_state => true }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of @@ -617,7 +625,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> TimerTypes = #{}, loop_event_actions( Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, State, Data, NewActions); + Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, @@ -900,13 +908,13 @@ loop_event( {NewTimerRefs,NewTimerTypes} = cancel_timer_by_type( timeout, TimerRefs, TimerTypes), - {NewData,NextState,Actions} = + {NewData,NextState,Actions,EnterCall} = parse_event_result( true, Debug, NewS, Result, Events, Event, State, Data), loop_event_actions( Parent, Debug, S, NewTimerRefs, NewTimerTypes, - Events, Event, NextState, NewData, Actions); + Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, Debug, S, [Event|Events]) @@ -915,31 +923,16 @@ loop_event( loop_event_actions( Parent, Debug, #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, Actions) -> + Events, Event, NextState, NewData, + Actions, EnterCall) -> case parse_actions(Debug, S, State, Actions) of {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> if - StateEnter, NextState =/= State -> + StateEnter, EnterCall -> loop_event_enter( Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR); - StateEnter -> - case maps:is_key(init_state, S) of - true -> - %% Avoid infinite loop in initial state - %% with state entry events - NewS = maps:remove(init_state, S), - loop_event_enter( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; true -> loop_event_result( Parent, NewDebug, S, TimerRefs, TimerTypes, @@ -958,14 +951,16 @@ loop_event_enter( Hibernate, TimeoutsR, Postpone, NextEventsR) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> - {NewerData,_,Actions} = - parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData), - loop_event_enter_actions( - Parent, Debug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewerData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + case parse_event_result( + false, Debug, NewS, Result, + Events, Event, NextState, NewData) of + {NewerData,_,Actions,EnterCall} -> + loop_event_enter_actions( + Parent, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) + end; {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, @@ -974,19 +969,27 @@ loop_event_enter( end. loop_event_enter_actions( - Parent, Debug, S, TimerRefs, TimerTypes, + Parent, Debug, #{state_enter := StateEnter} = S, TimerRefs, TimerTypes, Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) -> case parse_enter_actions( - Debug, S, NextState, Actions, - Hibernate, TimeoutsR) + Debug, S, NextState, Actions, Hibernate, TimeoutsR) of {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + if + StateEnter, EnterCall -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + true -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR) + end; {Class,Reason,Stacktrace} -> terminate( Class, Reason, Stacktrace, @@ -1212,6 +1215,7 @@ parse_event_result( terminate( exit, Reason, ?STACKTRACE(), Debug, S#{data := NewData}, [Event|Events]); + %% {stop_and_reply,Reason,Replies} -> Q = [Event|Events], reply_then_terminate( @@ -1222,22 +1226,34 @@ parse_event_result( reply_then_terminate( exit, Reason, ?STACKTRACE(), Debug, S#{data := NewData}, Q, Replies); + %% {next_state,State,NewData} -> - {NewData,State,[]}; + {NewData,State,[],false}; {next_state,NextState,NewData} when AllowStateChange -> - {NewData,NextState,[]}; + {NewData,NextState,[],true}; {next_state,State,NewData,Actions} -> - {NewData,State,Actions}; + {NewData,State,Actions,false}; {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NewData,NextState,Actions}; + {NewData,NextState,Actions,true}; + %% {keep_state,NewData} -> - {NewData,State,[]}; + {NewData,State,[],false}; {keep_state,NewData,Actions} -> - {NewData,State,Actions}; + {NewData,State,Actions,false}; keep_state_and_data -> - {Data,State,[]}; + {Data,State,[],false}; {keep_state_and_data,Actions} -> - {Data,State,Actions}; + {Data,State,Actions,false}; + %% + {repeat_state,NewData} -> + {NewData,State,[],true}; + {repeat_state,NewData,Actions} -> + {NewData,State,Actions,true}; + repeat_state_and_data -> + {Data,State,[],true}; + {repeat_state_and_data,Actions} -> + {Data,State,Actions,true}; + %% _ -> terminate( error, -- cgit v1.2.3 From 7520c1cb702250b20e7d1f731742e062036f6bec Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 30 Jan 2017 16:15:14 +0100 Subject: Bugfix: callback mode not cached after code change Fix lots of internal state updates just before termination that could cause crash reports confused about timers. --- lib/stdlib/src/gen_statem.erl | 149 +++++++++++++++++++++++++++++------------- 1 file changed, 103 insertions(+), 46 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 5de31ebfe0..0d04755556 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -622,14 +622,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> case call_callback_mode(S) of {ok,NewS} -> TimerRefs = #{}, + %% S map key: timer_refs + %% Key: timer ref + %% Value: the timer type i.e the timer's event type + %% TimerTypes = #{}, + %% S map key: timer_types + %% Key: timer type i.e the timer's event type + %% Value: timer ref + %% loop_event_actions( Parent, NewDebug, NewS, TimerRefs, TimerTypes, Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - NewDebug, S, [Event|Events]) + Class, Reason, Stacktrace, NewDebug, + S, [Event|Events]) end. %%%========================================================================== @@ -698,9 +706,7 @@ system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). system_terminate(Reason, _Parent, Debug, S) -> - terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, []). + terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( #{module := Module, @@ -827,22 +833,26 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) -> %% Entry point for wakeup_from_hibernate/3 loop_receive( - Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> + Parent, Debug, + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S) -> receive Msg -> case Msg of {system,Pid,Req} -> - #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + Req, Pid, Parent, ?MODULE, Debug, + S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + exit, Reason, ?STACKTRACE(), Debug, + S, [EXIT]); {timeout,TimerRef,TimerMsg} -> case TimerRefs of #{TimerRef := TimerType} -> @@ -906,18 +916,22 @@ loop_event( {ok,Result,NewS} -> %% Cancel event timeout {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type( - timeout, TimerRefs, TimerTypes), + cancel_timer_by_type(timeout, TimerRefs, TimerTypes), {NewData,NextState,Actions,EnterCall} = parse_event_result( - true, Debug, NewS, Result, - Events, Event, State, Data), + true, Debug, NewS, NewTimerRefs, NewTimerTypes, + Events, Event, State, Data, Hibernate, Result), loop_event_actions( - Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Parent, Debug, NewS, TimerRefs, NewTimerTypes, Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) + Class, Reason, Stacktrace, Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + [Event|Events]) end. loop_event_actions( @@ -941,8 +955,13 @@ loop_event_actions( end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{data := NewData}, [Event|Events]) + Class, Reason, Stacktrace, Debug, + S#{ + data := NewData, + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := false}, + [Event|Events]) end. loop_event_enter( @@ -952,8 +971,8 @@ loop_event_enter( case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> case parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData) of + false, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, Hibernate, Result) of {NewerData,_,Actions,EnterCall} -> loop_event_enter_actions( Parent, Debug, NewS, TimerRefs, TimerTypes, @@ -963,8 +982,13 @@ loop_event_enter( end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, [Event|Events]) end. @@ -992,8 +1016,13 @@ loop_event_enter_actions( end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, [Event|Events]) end. @@ -1020,7 +1049,8 @@ loop_event_result( %% state timeout if the state changes if NextState =:= State -> - {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + {Events,P_1, + {TimerRefs_0,TimerTypes_0}}; true -> {lists:reverse(P_1, Events),[], cancel_timer_by_type( @@ -1051,9 +1081,9 @@ loop_events( state := State, data := Data, postponed := P, - hibernate => Hibernate, timer_refs => TimerRefs, - timer_types => TimerTypes}, + timer_types => TimerTypes, + hibernate => Hibernate}, loop(Parent, Debug, NewS); loop_events( Parent, Debug, S, TimerRefs, TimerTypes, @@ -1203,29 +1233,54 @@ call_state_function( %% Interpret all callback return variants parse_event_result( - AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> + AllowStateChange, Debug, S, TimerRefs, TimerTypes, + Events, Event, State, Data, Hibernate, Result) -> case Result of stop -> terminate( - exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, normal, ?STACKTRACE(), Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + [Event|Events]); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + [Event|Events]); {stop,Reason,NewData} -> terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{ + data := NewData, + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + [Event|Events]); %% {stop_and_reply,Reason,Replies} -> Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + Q, Replies); {stop_and_reply,Reason,Replies,NewData} -> Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{ + data := NewData, + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + Q, Replies); %% {next_state,State,NewData} -> {NewData,State,[],false}; @@ -1259,7 +1314,12 @@ parse_event_result( error, {bad_return_from_state_function,Result}, ?STACKTRACE(), - Debug, S, [Event|Events]) + Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate}, + [Event|Events]) end. @@ -1471,17 +1531,17 @@ process_timeout_events( %% Server helpers reply_then_terminate( - Class, Reason, Stacktrace, - Debug, #{state := State} = S, Q, Replies) -> + Class, Reason, Stacktrace, Debug, + #{state := State} = S, Q, Replies) -> if is_list(Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, Replies, State); + Class, Reason, Stacktrace, Debug, + S, Q, Replies, State); true -> do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, [Replies], State) + Class, Reason, Stacktrace, Debug, + S, Q, [Replies], State) end. %% do_reply_then_terminate( @@ -1508,8 +1568,7 @@ do_reply(Debug, S, State, From, Reply) -> terminate( - Class, Reason, Stacktrace, - Debug, + Class, Reason, Stacktrace, Debug, #{module := Module, state := State, data := Data, postponed := P} = S, Q) -> try Module:terminate(Reason, State, Data) of @@ -1670,8 +1729,6 @@ cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> {TimerRefs,TimerTypes} end. -%%cancel_timer(undefined) -> -%% ok; cancel_timer(TRef) -> case erlang:cancel_timer(TRef) of false -> -- cgit v1.2.3 From e2b9e07ce563b4dbd1885ceabf575d431901bede Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 1 Feb 2017 21:38:50 +0100 Subject: Optimize by using async cancel_timer --- lib/stdlib/src/gen_statem.erl | 316 ++++++++++++++++++++++++++++-------------- 1 file changed, 213 insertions(+), 103 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 0d04755556..6ad025d6c9 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -606,6 +606,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> true -> [Actions,{postpone,false}] end, + TimerRefs = #{}, + %% Key: timer ref + %% Value: the timer type i.e the timer's event type + %% + TimerTypes = #{}, + %% Key: timer type i.e the timer's event type + %% Value: timer ref + %% + %% We add a timer to both timer_refs and timer_types + %% when we start it. When we request an asynchronous + %% timer cancel we remove it from timer_types. When + %% the timer cancel message arrives we remove it from + %% timer_refs. + %% + Hibernate = false, + CancelTimers = 0, S = #{ callback_mode => undefined, state_enter => false, @@ -613,26 +629,21 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> name => Name, state => State, data => Data, - postponed => P - %% The rest of the fields are set from to the arguments to + postponed => P, + %% + %% The following fields are finally set from to the arguments to %% loop_event_actions/11 when it finally loops back to loop/3 %% in loop_events/10 + timer_refs => TimerRefs, + timer_types => TimerTypes, + hibernate => Hibernate, + cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> - TimerRefs = #{}, - %% S map key: timer_refs - %% Key: timer ref - %% Value: the timer type i.e the timer's event type - %% - TimerTypes = #{}, - %% S map key: timer_types - %% Key: timer type i.e the timer's event type - %% Value: timer ref - %% loop_event_actions( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Parent, NewDebug, NewS, TimerRefs, TimerTypes, CancelTimers, Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( @@ -817,26 +828,36 @@ wakeup_from_hibernate(Parent, Debug, S) -> %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 -loop(Parent, Debug, #{hibernate := Hibernate} = S) -> - case Hibernate of - true -> - %% Does not return but restarts process at - %% wakeup_from_hibernate/3 that jumps to loop_receive/3 - proc_lib:hibernate( - ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), - error( - {should_not_have_arrived_here_but_instead_in, - {wakeup_from_hibernate,3}}); - false -> - loop_receive(Parent, Debug, S) - end. +loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) -> + loop_hibernate(Parent, Debug, S); +loop(Parent, Debug, S) -> + loop_receive(Parent, Debug, S). + +loop_hibernate(Parent, Debug, S) -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 loop_receive( Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes, - hibernate := Hibernate} = S) -> + cancel_timers := CancelTimers} = S) -> + loop_receive(Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers). +%% +loop_receive( + Parent, Debug, + #{hibernate := Hibernate} = S, + TimerRefs, TimerTypes, CancelTimers) -> + %% The fields 'timer_refs', 'timer_types' and 'cancel_timers' + %% are now invalid in state map S - they will be recalculated + %% and restored when we return to loop/3 + %% receive Msg -> case Msg of @@ -845,29 +866,90 @@ loop_receive( %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, - S, Hibernate); + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + cancel_timers := CancelTimers}, + Hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... terminate( exit, Reason, ?STACKTRACE(), Debug, - S, [EXIT]); + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + cancel_timers := CancelTimers}, + [EXIT]); {timeout,TimerRef,TimerMsg} -> case TimerRefs of #{TimerRef := TimerType} -> - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout + %% We know of this timer, is it a running + %% timer or a timer being cancelled but + %% managed to send a late timeout message? + case TimerTypes of + #{TimerType := TimerRef} -> + %% The timer type maps to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + CancelTimers, Event); + _ -> + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel + %% ack shortly + loop_receive( + Parent, Debug, S, + TimerRefs, TimerTypes, CancelTimers) + end; + _ -> + Event = {info,Msg}, loop_receive_result( Parent, Debug, S, - maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes), - Event); + TimerRefs, TimerTypes, CancelTimers, Event) + end; + {cancel_timer,TimerRef,_} -> + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + if + Hibernate =:= true, CancelTimers =:= 0 -> + loop_hibernate( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := TimerTypes, + cancel_timers := CancelTimers}); + CancelTimers > 0 -> + loop_receive( + Parent, Debug, S, + NewTimerRefs, TimerTypes, + CancelTimers - 1); + true -> + terminate( + error, impossible_message, + ?STACKTRACE(), Debug, + S#{ + timer_refs := TimerRefs, + timer_types := TimerTypes, + cancel_timers := CancelTimers}, + [Msg]) + end; _ -> Event = {info,Msg}, loop_receive_result( Parent, Debug, S, - TimerRefs, TimerTypes, Event) + TimerRefs, TimerTypes, CancelTimers, Event) end; _ -> Event = @@ -881,27 +963,28 @@ loop_receive( end, loop_receive_result( Parent, Debug, S, - TimerRefs, TimerTypes, Event) + TimerRefs, TimerTypes, CancelTimers, Event) end end. loop_receive_result( Parent, Debug, #{state := State} = S, - TimerRefs, TimerTypes, Event) -> - %% The fields 'timer_refs', 'timer_types' and 'hibernate' - %% are now invalid in state map S - they will be recalculated - %% and restored when we return to loop/3 + TimerRefs, TimerTypes, CancelTimers, Event) -> + %% The field 'hibernate' is now invalid in state map S + %% - it will be recalculated and restored when we return to loop/3 %% NewDebug = sys_debug(Debug, S, State, {in,Event}), %% Here the queue of not yet handled events is created Events = [], Hibernate = false, loop_event( - Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). + Parent, NewDebug, S, TimerRefs, TimerTypes, CancelTimers, + Events, Event, Hibernate). %% Entry point for handling an event, received or enqueued loop_event( - Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Parent, Debug, #{state := State, data := Data} = S, + TimerRefs, TimerTypes, CancelTimers, Events, {Type,Content} = Event, Hibernate) -> %% %% If Hibernate is true here it can only be @@ -912,17 +995,23 @@ loop_event( %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), + %% So now the old Hibernate is dead, and a new one emerges + %% within loop_event_actions case call_state_function(S, Type, Content, State, Data) of {ok,Result,NewS} -> %% Cancel event timeout - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type(timeout, TimerRefs, TimerTypes), + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type(timeout, TimerTypes, CancelTimers), + %% The timer is removed from NewTimerTypes but + %% remains in TimerRefs until we get the cancel_timers msg {NewData,NextState,Actions,EnterCall} = parse_event_result( - true, Debug, NewS, NewTimerRefs, NewTimerTypes, - Events, Event, State, Data, Hibernate, Result), + true, Debug, NewS, + TimerRefs, NewTimerTypes, NewCancelTimers, + Events, Event, State, Data, false, Result), loop_event_actions( - Parent, Debug, NewS, TimerRefs, NewTimerTypes, + Parent, Debug, NewS, + TimerRefs, NewTimerTypes, NewCancelTimers, Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( @@ -930,13 +1019,15 @@ loop_event( S#{ timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. loop_event_actions( Parent, Debug, - #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, + #{state := State, state_enter := StateEnter} = S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Actions, EnterCall) -> case parse_actions(Debug, S, State, Actions) of @@ -944,12 +1035,14 @@ loop_event_actions( if StateEnter, EnterCall -> loop_event_enter( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR); true -> loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) end; @@ -960,22 +1053,25 @@ loop_event_actions( data := NewData, timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := false}, [Event|Events]) end. loop_event_enter( - Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Parent, Debug, #{state := State} = S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> case parse_event_result( - false, Debug, NewS, TimerRefs, TimerTypes, + false, Debug, NewS, TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, Result) of {NewerData,_,Actions,EnterCall} -> loop_event_enter_actions( - Parent, Debug, NewS, TimerRefs, TimerTypes, + Parent, Debug, NewS, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewerData, Hibernate, TimeoutsR, Postpone, NextEventsR, Actions, EnterCall) @@ -988,12 +1084,14 @@ loop_event_enter( data := NewData, timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. loop_event_enter_actions( - Parent, Debug, #{state_enter := StateEnter} = S, TimerRefs, TimerTypes, + Parent, Debug, #{state_enter := StateEnter} = S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR, Actions, EnterCall) -> @@ -1005,12 +1103,14 @@ loop_event_enter_actions( if StateEnter, EnterCall -> loop_event_enter( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, NewHibernate, NewTimeoutsR, Postpone, NextEventsR); true -> loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, + TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, NewHibernate, NewTimeoutsR, Postpone, NextEventsR) end; @@ -1022,13 +1122,15 @@ loop_event_enter_actions( data := NewData, timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. loop_event_result( Parent, Debug, - #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + #{state := State, postponed := P_0} = S, + TimerRefs_0, TimerTypes_0, CancelTimers_0, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> %% @@ -1044,21 +1146,23 @@ loop_event_result( {sys_debug(Debug, S, State, {consume,Event,State}), P_0} end, - {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + {Events_1,NewP,{TimerTypes_1,CancelTimers_1}} = %% Move all postponed events to queue and cancel the %% state timeout if the state changes if NextState =:= State -> - {Events,P_1, - {TimerRefs_0,TimerTypes_0}}; + {Events,P_1,{TimerTypes_0,CancelTimers_0}}; true -> {lists:reverse(P_1, Events),[], cancel_timer_by_type( - state_timeout, TimerRefs_0, TimerTypes_0)} + state_timeout, TimerTypes_0, CancelTimers_0)} + %% The state timer is removed from TimerTypes_1 + %% but remains in TimerRefs_0 until we get + %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + {TimerRefs_2,TimerTypes_2,NewCancelTimers,TimeoutEvents} = %% Stop and start timers non-event timers - parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), %% Place next events last in reversed queue Events_2R = lists:reverse(Events_1, NextEventsR), %% Enqueue immediate timeout events and start event timer @@ -1067,13 +1171,13 @@ loop_event_result( TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), NewEvents = lists:reverse(Events_3R), loop_events( - Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, + Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, NewCancelTimers, NewEvents, Hibernate, NextState, NewData, NewP). %% Loop until out of enqueued events %% loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, + Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers, [] = _Events, Hibernate, State, Data, P) -> %% Update S and loop back to loop/3 to receive a new event NewS = @@ -1081,12 +1185,13 @@ loop_events( state := State, data := Data, postponed := P, - timer_refs => TimerRefs, - timer_types => TimerTypes, - hibernate => Hibernate}, + timer_refs := TimerRefs, + timer_types := TimerTypes, + cancel_timers := CancelTimers, + hibernate := Hibernate}, loop(Parent, Debug, NewS); loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, + Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers, [Event|Events], Hibernate, State, Data, P) -> %% Update S and continue with enqueued events NewS = @@ -1095,7 +1200,8 @@ loop_events( data := Data, postponed := P}, loop_event( - Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). + Parent, Debug, NewS, TimerRefs, TimerTypes, CancelTimers, + Events, Event, Hibernate). @@ -1233,7 +1339,7 @@ call_state_function( %% Interpret all callback return variants parse_event_result( - AllowStateChange, Debug, S, TimerRefs, TimerTypes, + AllowStateChange, Debug, S, TimerRefs, TimerTypes, CancelTimers, Events, Event, State, Data, Hibernate, Result) -> case Result of stop -> @@ -1242,6 +1348,7 @@ parse_event_result( S#{ timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]); {stop,Reason} -> @@ -1250,6 +1357,7 @@ parse_event_result( S#{ timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]); {stop,Reason,NewData} -> @@ -1259,6 +1367,7 @@ parse_event_result( data := NewData, timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]); %% @@ -1269,6 +1378,7 @@ parse_event_result( S#{ timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, Q, Replies); {stop_and_reply,Reason,Replies,NewData} -> @@ -1279,6 +1389,7 @@ parse_event_result( data := NewData, timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, Q, Replies); %% @@ -1318,6 +1429,7 @@ parse_event_result( S#{ timer_refs := TimerRefs, timer_types := TimerTypes, + cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. @@ -1445,49 +1557,55 @@ parse_actions( %% and pending event timer %% %% Stop and start timers non-event timers -parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). %% -parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], + Seen, TimeoutEvents) -> {TimerType,Time,TimerMsg} = Timeout, case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, %% Cancel any running timer - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type(TimerType, TimerTypes, CancelTimers), + %% This removes it from NewTimerTypes but its ref stays + %% in TimerRefs until we get the cancel_timer msg if Time =:= infinity -> %% Ignore - timer will never fire parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); TimerType =:= timeout -> %% Handle event timer later parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [Timeout|TimeoutEvents]); Time =:= 0 -> %% Handle zero time timeouts later TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); true -> %% Start a new timer TimerRef = erlang:start_timer(Time, self(), TimerMsg), + %% Insert it both into TimerRefs and TimerTypes parse_timers( - NewTimerRefs#{TimerRef => TimerType}, + TimerRefs#{TimerRef => TimerType}, NewTimerTypes#{TimerType => TimerRef}, - TimeoutsR, NewSeen, TimeoutEvents) + NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents) end end. @@ -1719,26 +1837,18 @@ listify(Item) -> [Item]. %% Cancel timer if running, otherwise no op -cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> +%% +%% This is an asynchronous cancel so the timer is not really cancelled +%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}. +%% In the mean time we might get a timeout message. +%% +%% Remove the timer from TimerTypes. +%% When we get the cancel_timer msg we remove it from TimerRefs. +cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> case TimerTypes of #{TimerType := TimerRef} -> - cancel_timer(TimerRef), - {maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes)}; + _ = erlang:cancel_timer(TimerRef, [{async,true}]), + {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerRefs,TimerTypes} - end. - -cancel_timer(TRef) -> - case erlang:cancel_timer(TRef) of - false -> - %% We have to assume that TRef is the ref of a running timer - %% and if so the timer has expired - %% hence we must wait for the timeout message - receive - {timeout,TRef,_} -> - ok - end; - _TimeLeft -> - ok + {TimerTypes,CancelTimers} end. -- cgit v1.2.3 From 67371bac3a00a04c226033ff423cc575b0aa2090 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 2 Feb 2017 16:18:06 +0100 Subject: Reduce number of loop variables hence code mass --- lib/stdlib/src/gen_statem.erl | 393 +++++++++++++++++------------------------- 1 file changed, 154 insertions(+), 239 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6ad025d6c9..15c01c1006 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -632,8 +632,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> postponed => P, %% %% The following fields are finally set from to the arguments to - %% loop_event_actions/11 when it finally loops back to loop/3 - %% in loop_events/10 + %% loop_event_actions/9 when it finally loops back to loop/3 + %% in loop_event_result/11 timer_refs => TimerRefs, timer_types => TimerTypes, hibernate => Hibernate, @@ -643,7 +643,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> case call_callback_mode(S) of {ok,NewS} -> loop_event_actions( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, CancelTimers, + Parent, NewDebug, NewS, Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( @@ -843,78 +843,66 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive( - Parent, Debug, - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers} = S) -> - loop_receive(Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers). -%% -loop_receive( - Parent, Debug, - #{hibernate := Hibernate} = S, - TimerRefs, TimerTypes, CancelTimers) -> - %% The fields 'timer_refs', 'timer_types' and 'cancel_timers' - %% are now invalid in state map S - they will be recalculated - %% and restored when we return to loop/3 - %% +loop_receive(Parent, Debug, S) -> receive Msg -> case Msg of {system,Pid,Req} -> + #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers}, + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple and therefore - %% not an event and has no event_type(), - %% but this will stand out in the crash report... - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers}, - [EXIT]); + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, case TimerRefs of #{TimerRef := TimerType} -> - %% We know of this timer, is it a running - %% timer or a timer being cancelled but + %% We know of this timer; is it a running + %% timer or a timer being cancelled that %% managed to send a late timeout message? case TimerTypes of #{TimerType := TimerRef} -> - %% The timer type maps to this + %% The timer type maps back to this %% timer ref, so it was a running timer Event = {TimerType,TimerMsg}, %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), loop_receive_result( - Parent, Debug, S, - maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes), - CancelTimers, Event); + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); _ -> %% This was a late timeout message %% from timer being cancelled, so - %% ignore it and expect a cancel - %% ack shortly - loop_receive( - Parent, Debug, S, - TimerRefs, TimerTypes, CancelTimers) + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) end; _ -> + %% Not our timer; present it as an event Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, CancelTimers, Event) + Parent, Debug, S, Hibernate, Event) end; {cancel_timer,TimerRef,_} -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, case TimerRefs of #{TimerRef := _} -> %% We must have requested a cancel @@ -922,36 +910,29 @@ loop_receive( %% removed from TimerTypes NewTimerRefs = maps:remove(TimerRef, TimerRefs), + NewCancelTimers = CancelTimers - 1, + NewS = + S#{ + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, if - Hibernate =:= true, CancelTimers =:= 0 -> - loop_hibernate( - Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers}); - CancelTimers > 0 -> - loop_receive( - Parent, Debug, S, - NewTimerRefs, TimerTypes, - CancelTimers - 1); - true -> - terminate( - error, impossible_message, - ?STACKTRACE(), Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers}, - [Msg]) + Hibernate =:= true, NewCancelTimers =:= 0 -> + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); + NewCancelTimers >= 0 -> % Assert + loop_receive(Parent, Debug, NewS) end; _ -> + %% Not our cancel_timer msg; + %% present it as an event Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, CancelTimers, Event) + Parent, Debug, S, Hibernate, Event) end; _ -> + %% External msg + #{hibernate := Hibernate} = S, Event = case Msg of {'$gen_call',From,Request} -> @@ -962,116 +943,105 @@ loop_receive( {info,Msg} end, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, CancelTimers, Event) + Parent, Debug, S, Hibernate, Event) end end. loop_receive_result( - Parent, Debug, #{state := State} = S, - TimerRefs, TimerTypes, CancelTimers, Event) -> - %% The field 'hibernate' is now invalid in state map S - %% - it will be recalculated and restored when we return to loop/3 - %% + Parent, Debug, #{state := State} = S, Hibernate, Event) -> + %% From now the 'hibernate' field in S is invalid + %% and will be restored when looping back + %% in loop_event_result/11 NewDebug = sys_debug(Debug, S, State, {in,Event}), - %% Here the queue of not yet handled events is created + %% Here is the queue of not yet handled events created Events = [], - Hibernate = false, - loop_event( - Parent, NewDebug, S, TimerRefs, TimerTypes, CancelTimers, - Events, Event, Hibernate). + loop_event(Parent, NewDebug, S, Events, Event, Hibernate). %% Entry point for handling an event, received or enqueued loop_event( - Parent, Debug, #{state := State, data := Data} = S, - TimerRefs, TimerTypes, CancelTimers, + Parent, Debug, + #{state := State, data := Data, timer_types := TimerTypes, + cancel_timers := CancelTimers} = S_0, Events, {Type,Content} = Event, Hibernate) -> %% - %% If Hibernate is true here it can only be + %% If (this old) Hibernate is true here it can only be %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user %% might rely on i.e collect garbage which %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), - %% So now the old Hibernate is dead, and a new one emerges - %% within loop_event_actions - case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> + case call_state_function(S_0, Type, Content, State, Data) of + {ok,Result,S_1} -> %% Cancel event timeout - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type(timeout, TimerTypes, CancelTimers), - %% The timer is removed from NewTimerTypes but - %% remains in TimerRefs until we get the cancel_timers msg - {NewData,NextState,Actions,EnterCall} = + S_2 = + case + cancel_timer_by_type(timeout, TimerTypes, CancelTimers) + of + {_,CancelTimers} -> + %% No timer cancelled + S_1; + {NewTimerTypes,NewCancelTimers} -> + %% The timer is removed from NewTimerTypes but + %% remains in TimerRefs until we get + %% the cancel_timer msg + S_1#{ + timer_types := NewTimerTypes, + cancel_timers := NewCancelTimers} + end, + {NextState,NewData,Actions,EnterCall} = parse_event_result( - true, Debug, NewS, - TimerRefs, NewTimerTypes, NewCancelTimers, - Events, Event, State, Data, false, Result), + true, Debug, S_2, + Events, Event, State, Data, Result), loop_event_actions( - Parent, Debug, NewS, - TimerRefs, NewTimerTypes, NewCancelTimers, + Parent, Debug, S_2, Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, + Class, Reason, Stacktrace, Debug, S_0, [Event|Events]) end. loop_event_actions( Parent, Debug, #{state := State, state_enter := StateEnter} = S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Actions, EnterCall) -> + %% Hibernate is reborn here as false being + %% the default value from parse_actions/4 case parse_actions(Debug, S, State, Actions) of {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> if StateEnter, EnterCall -> loop_event_enter( Parent, NewDebug, S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR); true -> loop_event_result( Parent, NewDebug, S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, - S#{ - data := NewData, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := false}, + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. loop_event_enter( Parent, Debug, #{state := State} = S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> case parse_event_result( - false, Debug, NewS, TimerRefs, TimerTypes, CancelTimers, - Events, Event, NextState, NewData, Hibernate, Result) of - {NewerData,_,Actions,EnterCall} -> + false, Debug, NewS, + Events, Event, NextState, NewData, Result) of + {_,NewerData,Actions,EnterCall} -> loop_event_enter_actions( Parent, Debug, NewS, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewerData, Hibernate, TimeoutsR, Postpone, NextEventsR, Actions, EnterCall) @@ -1082,16 +1052,12 @@ loop_event_enter( S#{ state := NextState, data := NewData, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. loop_event_enter_actions( Parent, Debug, #{state_enter := StateEnter} = S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR, Actions, EnterCall) -> @@ -1104,13 +1070,11 @@ loop_event_enter_actions( StateEnter, EnterCall -> loop_event_enter( Parent, NewDebug, S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, NewHibernate, NewTimeoutsR, Postpone, NextEventsR); true -> loop_event_result( Parent, NewDebug, S, - TimerRefs, TimerTypes, CancelTimers, Events, Event, NextState, NewData, NewHibernate, NewTimeoutsR, Postpone, NextEventsR) end; @@ -1120,89 +1084,71 @@ loop_event_enter_actions( S#{ state := NextState, data := NewData, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, hibernate := Hibernate}, [Event|Events]) end. loop_event_result( - Parent, Debug, - #{state := State, postponed := P_0} = S, - TimerRefs_0, TimerTypes_0, CancelTimers_0, - Events, Event, NextState, NewData, + Parent, Debug_0, + #{state := State, postponed := P_0, + timer_refs := TimerRefs_0, timer_types := TimerTypes_0, + cancel_timers := CancelTimers_0} = S_0, + Events_0, Event_0, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {NewDebug,P_1} = % Move current event to postponed if Postpone + {Debug_1,P_1} = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug, S, State, {postpone,Event,State}), - [Event|P_0]}; + {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), + [Event_0|P_0]}; false -> - {sys_debug(Debug, S, State, {consume,Event,State}), + {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), P_0} end, - {Events_1,NewP,{TimerTypes_1,CancelTimers_1}} = + {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = %% Move all postponed events to queue and cancel the %% state timeout if the state changes if NextState =:= State -> - {Events,P_1,{TimerTypes_0,CancelTimers_0}}; + {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; true -> - {lists:reverse(P_1, Events),[], + {lists:reverse(P_1, Events_0), + [], cancel_timer_by_type( state_timeout, TimerTypes_0, CancelTimers_0)} %% The state timer is removed from TimerTypes_1 %% but remains in TimerRefs_0 until we get %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,NewCancelTimers,TimeoutEvents} = - %% Stop and start timers non-event timers + {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = + %% Stop and start non-event timers parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), %% Place next events last in reversed queue Events_2R = lists:reverse(Events_1, NextEventsR), %% Enqueue immediate timeout events and start event timer - {NewTimerRefs,NewTimerTypes,Events_3R} = + {TimerRefs_3,TimerTypes_3,Events_3R} = process_timeout_events( TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), - NewEvents = lists:reverse(Events_3R), - loop_events( - Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, NewCancelTimers, - NewEvents, Hibernate, NextState, NewData, NewP). - -%% Loop until out of enqueued events -%% -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers, - [] = _Events, Hibernate, State, Data, P) -> - %% Update S and loop back to loop/3 to receive a new event - NewS = - S#{ - state := State, - data := Data, - postponed := P, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, + S_1 = + S_0#{ + state := NextState, + data := NewData, + postponed := P_2, + timer_refs := TimerRefs_3, + timer_types := TimerTypes_3, + cancel_timers := CancelTimers_2, hibernate := Hibernate}, - loop(Parent, Debug, NewS); -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, CancelTimers, - [Event|Events], Hibernate, State, Data, P) -> - %% Update S and continue with enqueued events - NewS = - S#{ - state := State, - data := Data, - postponed := P}, - loop_event( - Parent, Debug, NewS, TimerRefs, TimerTypes, CancelTimers, - Events, Event, Hibernate). - + case lists:reverse(Events_3R) of + [] -> + %% Get a new event + loop(Parent, Debug_1, S_1); + [Event|Events] -> + %% Loop until out of enqueued events + loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + end. %%--------------------------------------------------------------------------- @@ -1272,8 +1218,7 @@ parse_callback_mode(_, _CBMode, StateEnter) -> call_state_function( - #{callback_mode := undefined} = S, - Type, Content, State, Data) -> + #{callback_mode := undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of {ok,NewS} -> call_state_function(NewS, Type, Content, State, Data); @@ -1281,8 +1226,7 @@ call_state_function( Error end; call_state_function( - #{callback_mode := CallbackMode, - module := Module} = S, + #{callback_mode := CallbackMode, module := Module} = S, Type, Content, State, Data) -> try case CallbackMode of @@ -1339,105 +1283,74 @@ call_state_function( %% Interpret all callback return variants parse_event_result( - AllowStateChange, Debug, S, TimerRefs, TimerTypes, CancelTimers, - Events, Event, State, Data, Hibernate, Result) -> + AllowStateChange, Debug, S, + Events, Event, State, Data, Result) -> case Result of stop -> terminate( exit, normal, ?STACKTRACE(), Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, + S#{state := State, data := Data}, [Event|Events]); {stop,Reason} -> terminate( exit, Reason, ?STACKTRACE(), Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, + S#{state := State, data := Data}, [Event|Events]); {stop,Reason,NewData} -> terminate( exit, Reason, ?STACKTRACE(), Debug, - S#{ - data := NewData, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, + S#{state := State, data := NewData}, [Event|Events]); %% {stop_and_reply,Reason,Replies} -> - Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, - Q, Replies); + S#{state := State, data := Data}, + [Event|Events], Replies); {stop_and_reply,Reason,Replies,NewData} -> - Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), Debug, - S#{ - data := NewData, - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, - Q, Replies); + S#{state := State, data := NewData}, + [Event|Events], Replies); %% {next_state,State,NewData} -> - {NewData,State,[],false}; + {State,NewData,[],false}; {next_state,NextState,NewData} when AllowStateChange -> - {NewData,NextState,[],true}; + {NextState,NewData,[],true}; {next_state,State,NewData,Actions} -> - {NewData,State,Actions,false}; + {State,NewData,Actions,false}; {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NewData,NextState,Actions,true}; + {NextState,NewData,Actions,true}; %% {keep_state,NewData} -> - {NewData,State,[],false}; + {State,NewData,[],false}; {keep_state,NewData,Actions} -> - {NewData,State,Actions,false}; + {State,NewData,Actions,false}; keep_state_and_data -> - {Data,State,[],false}; + {State,Data,[],false}; {keep_state_and_data,Actions} -> - {Data,State,Actions,false}; + {State,Data,Actions,false}; %% {repeat_state,NewData} -> - {NewData,State,[],true}; + {State,NewData,[],true}; {repeat_state,NewData,Actions} -> - {NewData,State,Actions,true}; + {State,NewData,Actions,true}; repeat_state_and_data -> - {Data,State,[],true}; + {State,Data,[],true}; {repeat_state_and_data,Actions} -> - {Data,State,Actions,true}; + {State,Data,Actions,true}; %% _ -> terminate( error, {bad_return_from_state_function,Result}, - ?STACKTRACE(), - Debug, - S#{ - timer_refs := TimerRefs, - timer_types := TimerTypes, - cancel_timers := CancelTimers, - hibernate := Hibernate}, + ?STACKTRACE(), Debug, + S#{state := State, data := Data}, [Event|Events]) end. -parse_enter_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR) -> +parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> Postpone = forbidden, NextEventsR = forbidden, parse_actions( @@ -1484,9 +1397,10 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()}; hibernate -> + NewHibernate = true, parse_actions( Debug, S, State, Actions, - true, TimeoutsR, Postpone, NextEventsR); + NewHibernate, TimeoutsR, Postpone, NextEventsR); {state_timeout,Time,_} = StateTimeout when is_integer(Time), Time >= 0; Time =:= infinity -> @@ -1529,9 +1443,10 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()}; postpone when Postpone =/= forbidden -> + NewPostpone = true, parse_actions( Debug, S, State, Actions, - Hibernate, TimeoutsR, true, NextEventsR); + Hibernate, TimeoutsR, NewPostpone, NextEventsR); {next_event,Type,Content} -> case event_type(Type) of true when NextEventsR =/= forbidden -> -- cgit v1.2.3 From 681b30df0caff7157c0c75aaeeaa8f38d194f2b2 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 6 Feb 2017 16:06:08 +0100 Subject: Clean up timer handling --- lib/stdlib/src/gen_statem.erl | 112 +++++++++++++++++++++++++----------------- 1 file changed, 66 insertions(+), 46 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 15c01c1006..6d9a828319 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -948,20 +948,38 @@ loop_receive(Parent, Debug, S) -> end. loop_receive_result( - Parent, Debug, #{state := State} = S, Hibernate, Event) -> + Parent, Debug, + #{state := State, + timer_types := TimerTypes, cancel_timers := CancelTimers} = S, + Hibernate, Event) -> %% From now the 'hibernate' field in S is invalid %% and will be restored when looping back %% in loop_event_result/11 NewDebug = sys_debug(Debug, S, State, {in,Event}), %% Here is the queue of not yet handled events created Events = [], - loop_event(Parent, NewDebug, S, Events, Event, Hibernate). + %% Cancel any running event timer + case + cancel_timer_by_type(timeout, TimerTypes, CancelTimers) + of + {_,CancelTimers} -> + %% No timer cancelled + loop_event(Parent, NewDebug, S, Events, Event, Hibernate); + {NewTimerTypes,NewCancelTimers} -> + %% The timer is removed from NewTimerTypes but + %% remains in TimerRefs until we get + %% the cancel_timer msg + NewS = + S#{ + timer_types := NewTimerTypes, + cancel_timers := NewCancelTimers}, + loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate) + end. %% Entry point for handling an event, received or enqueued loop_event( Parent, Debug, - #{state := State, data := Data, timer_types := TimerTypes, - cancel_timers := CancelTimers} = S_0, + #{state := State, data := Data} = S, Events, {Type,Content} = Event, Hibernate) -> %% %% If (this old) Hibernate is true here it can only be @@ -972,34 +990,18 @@ loop_event( %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), - case call_state_function(S_0, Type, Content, State, Data) of - {ok,Result,S_1} -> - %% Cancel event timeout - S_2 = - case - cancel_timer_by_type(timeout, TimerTypes, CancelTimers) - of - {_,CancelTimers} -> - %% No timer cancelled - S_1; - {NewTimerTypes,NewCancelTimers} -> - %% The timer is removed from NewTimerTypes but - %% remains in TimerRefs until we get - %% the cancel_timer msg - S_1#{ - timer_types := NewTimerTypes, - cancel_timers := NewCancelTimers} - end, + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> {NextState,NewData,Actions,EnterCall} = parse_event_result( - true, Debug, S_2, + true, Debug, NewS, Events, Event, State, Data, Result), loop_event_actions( - Parent, Debug, S_2, + Parent, Debug, NewS, Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, S_0, + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. @@ -1412,7 +1414,7 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()}; {timeout,infinity,_} -> - %% Ignore - timeout will never happen and already cancelled + %% Ignore - timeout will never happen and is already cancelled parse_actions( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR); @@ -1467,7 +1469,6 @@ parse_actions( ?STACKTRACE()} end. - %% Stop and start timers as well as create timeout zero events %% and pending event timer %% @@ -1491,36 +1492,52 @@ parse_timers( #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, - %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type(TimerType, TimerTypes, CancelTimers), - %% This removes it from NewTimerTypes but its ref stays - %% in TimerRefs until we get the cancel_timer msg if - Time =:= infinity -> - %% Ignore - timer will never fire - parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); TimerType =:= timeout -> %% Handle event timer later parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, NewSeen, [Timeout|TimeoutEvents]); + Time =:= infinity -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), + parse_timers( + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, + NewSeen, TimeoutEvents); Time =:= 0 -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later TimeoutEvent = {TimerType,TimerMsg}, parse_timers( TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); true -> - %% Start a new timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - %% Insert it both into TimerRefs and TimerTypes - parse_timers( - TimerRefs#{TimerRef => TimerType}, - NewTimerTypes#{TimerType => TimerRef}, - NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents) + %% (Re)start the timer + TimerRef = + erlang:start_timer(Time, self(), TimerMsg), + case TimerTypes of + #{TimerType := OldTimerRef} -> + %% Cancel the running timer + cancel_timer(OldTimerRef), + %% Insert the new timer into + %% both TimerRefs and TimerTypes + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + CancelTimers + 1, + TimeoutsR, NewSeen, TimeoutEvents); + #{} -> + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + CancelTimers, + TimeoutsR, NewSeen, TimeoutEvents) + end end end. @@ -1762,8 +1779,11 @@ listify(Item) -> cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> case TimerTypes of #{TimerType := TimerRef} -> - _ = erlang:cancel_timer(TimerRef, [{async,true}]), + cancel_timer(TimerRef), {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> {TimerTypes,CancelTimers} end. + +cancel_timer(TimerRef) -> + ok = erlang:cancel_timer(TimerRef, [{async,true}]). -- cgit v1.2.3 From 4480ccb6cb8fd911d5fd20f436a0a84132c9ca7d Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 7 Feb 2017 18:03:13 +0100 Subject: Remove event timer optimization Handle the event timer more like other timers and do not optimize the odd case of combining an event timeout with inserting custom events, wich by definition cancels the event timeout. --- lib/stdlib/src/gen_statem.erl | 86 ++++++++++++++++--------------------------- 1 file changed, 31 insertions(+), 55 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6d9a828319..7a23a2a681 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1131,16 +1131,14 @@ loop_event_result( %% Place next events last in reversed queue Events_2R = lists:reverse(Events_1, NextEventsR), %% Enqueue immediate timeout events and start event timer - {TimerRefs_3,TimerTypes_3,Events_3R} = - process_timeout_events( - TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), + Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R), S_1 = S_0#{ state := NextState, data := NewData, postponed := P_2, - timer_refs := TimerRefs_3, - timer_types := TimerTypes_3, + timer_refs := TimerRefs_2, + timer_types := TimerTypes_2, cancel_timers := CancelTimers_2, hibernate := Hibernate}, case lists:reverse(Events_3R) of @@ -1361,7 +1359,7 @@ parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> parse_actions(Debug, S, State, Actions) -> Hibernate = false, - TimeoutsR = [], + TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer Postpone = false, NextEventsR = [], parse_actions( @@ -1413,12 +1411,9 @@ parse_actions( {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - {timeout,infinity,_} -> - %% Ignore - timeout will never happen and is already cancelled - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> + {timeout,Time,_} = Timeout + when is_integer(Time), Time >= 0; + Time =:= infinity -> parse_actions( Debug, S, State, Actions, Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); @@ -1426,11 +1421,9 @@ parse_actions( {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - infinity -> % Ignore - timeout will never happen - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - Time when is_integer(Time), Time >= 0 -> + Time + when is_integer(Time), Time >= 0; + Time =:= infinity -> Timeout = {timeout,Time,Time}, parse_actions( Debug, S, State, Actions, @@ -1493,11 +1486,6 @@ parse_timers( %% Unseen type - handle NewSeen = Seen#{TimerType => true}, if - TimerType =:= timeout -> - %% Handle event timer later - parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - NewSeen, [Timeout|TimeoutEvents]); Time =:= infinity -> %% Cancel any running timer {NewTimerTypes,NewCancelTimers} = @@ -1541,39 +1529,27 @@ parse_timers( end end. -%% Enqueue immediate timeout events and start event timer -process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> - {TimerRefs, TimerTypes, EventsR}; -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,0,TimerMsg}|TimeoutEvents], []) -> - %% No enqueued events - insert a timeout zero event - TimeoutEvent = {timeout,TimerMsg}, - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent]); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,Time,TimerMsg}], []) -> - %% No enqueued events - start event timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - process_timeout_events( - TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, - [], []); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> - %% There will be some other event so optimize by not starting - %% an event timer to just have to cancel it again - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, EventsR); -process_timeout_events( - TimerRefs, TimerTypes, - [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent|EventsR]). +%% Enqueue immediate timeout events (timeout 0 events) +%% +%% Event timer timeout 0 events gets special treatment since +%% an event timer is cancelled by any received event, +%% so if there are enqueued events before the event timer +%% timeout 0 event - the event timer is cancelled hence no event. +%% +%% Other (state_timeout) timeout 0 events that are after +%% the event timer timeout 0 events are considered to +%% belong to timers that were started after the event timer +%% timeout 0 event fired, so they do not cancel the event timer. +%% +prepend_timeout_events([], EventsR) -> + EventsR; +prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> + prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); +prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + prepend_timeout_events(TimeoutEvents, EventsR); +prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> + %% Just prepend all others + prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]). -- cgit v1.2.3 From c3d724283257d5520714cd62d7377077c16e63aa Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 7 Feb 2017 21:31:13 +0100 Subject: Clean up timer handling --- lib/stdlib/src/gen_statem.erl | 125 +++++++++++++++++++++++------------------- 1 file changed, 68 insertions(+), 57 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7a23a2a681..fa14808f9a 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1356,7 +1356,7 @@ parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> parse_actions( Debug, S, State, listify(Actions), Hibernate, TimeoutsR, Postpone, NextEventsR). - + parse_actions(Debug, S, State, Actions) -> Hibernate = false, TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer @@ -1387,61 +1387,29 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; + %% %% Actions that set options {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, NewHibernate, TimeoutsR, Postpone, NextEventsR); - {hibernate,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; hibernate -> NewHibernate = true, parse_actions( Debug, S, State, Actions, NewHibernate, TimeoutsR, Postpone, NextEventsR); - {state_timeout,Time,_} = StateTimeout - when is_integer(Time), Time >= 0; - Time =:= infinity -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); - {state_timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - {timeout,Time,_} = Timeout - when is_integer(Time), Time >= 0; - Time =:= infinity -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); - {timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - Time - when is_integer(Time), Time >= 0; - Time =:= infinity -> - Timeout = {timeout,Time,Time}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + %% {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, Hibernate, TimeoutsR, NewPostpone, NextEventsR); - {postpone,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; postpone when Postpone =/= forbidden -> NewPostpone = true, parse_actions( Debug, S, State, Actions, Hibernate, TimeoutsR, NewPostpone, NextEventsR); + %% {next_event,Type,Content} -> case event_type(Type) of true when NextEventsR =/= forbidden -> @@ -1456,12 +1424,45 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; - _ -> + %% + {state_timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + Time -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Time) + end. + +parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> + Time = + case Timeout of + {_,T,_} -> T; + T -> T + end, + case validate_time(Time) of + true -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + false -> {error, - {bad_action_from_state_function,Action}, + {bad_action_from_state_function,Timeout}, ?STACKTRACE()} end. +validate_time(Time) when is_integer(Time), Time >= 0 -> true; +validate_time(infinity) -> true; +validate_time(_) -> false. + %% Stop and start timers as well as create timeout zero events %% and pending event timer %% @@ -1475,7 +1476,23 @@ parse_timers( parse_timers( TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> - {TimerType,Time,TimerMsg} = Timeout, + case Timeout of + {TimerType,Time,TimerMsg} -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg); + Time -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + timeout, Time, Time) + end. + +parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore @@ -1485,8 +1502,8 @@ parse_timers( #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, - if - Time =:= infinity -> + case Time of + infinity -> %% Cancel any running timer {NewTimerTypes,NewCancelTimers} = cancel_timer_by_type( @@ -1494,7 +1511,7 @@ parse_timers( parse_timers( TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); - Time =:= 0 -> + 0 -> %% Cancel any running timer {NewTimerTypes,NewCancelTimers} = cancel_timer_by_type( @@ -1504,7 +1521,7 @@ parse_timers( parse_timers( TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); - true -> + _ -> %% (Re)start the timer TimerRef = erlang:start_timer(Time, self(), TimerMsg), @@ -1512,19 +1529,20 @@ parse_timers( #{TimerType := OldTimerRef} -> %% Cancel the running timer cancel_timer(OldTimerRef), + NewCancelTimers = CancelTimers + 1, %% Insert the new timer into %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, TimerTypes#{TimerType => TimerRef}, - CancelTimers + 1, - TimeoutsR, NewSeen, TimeoutEvents); + NewCancelTimers, TimeoutsR, + NewSeen, TimeoutEvents); #{} -> parse_timers( TimerRefs#{TimerRef => TimerType}, TimerTypes#{TimerType => TimerRef}, - CancelTimers, - TimeoutsR, NewSeen, TimeoutEvents) + CancelTimers, TimeoutsR, + NewSeen, TimeoutEvents) end end end. @@ -1559,16 +1577,9 @@ prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> reply_then_terminate( Class, Reason, Stacktrace, Debug, #{state := State} = S, Q, Replies) -> - if - is_list(Replies) -> - do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, - S, Q, Replies, State); - true -> - do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, - S, Q, [Replies], State) - end. + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, + S, Q, listify(Replies), State). %% do_reply_then_terminate( Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> -- cgit v1.2.3 From 2f5f4ea9afccb7d8c82bdeb56440b1e43d9f34d0 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 22 Feb 2017 15:19:08 +0100 Subject: Stop pampering with stacktraces --- lib/stdlib/src/gen_statem.erl | 50 +------------------------------------------ 1 file changed, 1 insertion(+), 49 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index fa14808f9a..d7e8504564 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1161,19 +1161,6 @@ call_callback_mode(#{module := Module} = S) -> catch CallbackMode -> callback_mode_result(S, CallbackMode); - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,callback_mode,[]=Args,_} - |Stacktrace] -> - {error, - {undef_callback,{Module,callback_mode,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. @@ -1231,7 +1218,7 @@ call_state_function( try case CallbackMode of state_functions -> - erlang:apply(Module, State, [Type,Content,Data]); + Module:State(Type, Content, Data); handle_event_function -> Module:handle_event(Type, Content, State, Data) end @@ -1241,41 +1228,6 @@ call_state_function( catch Result -> {ok,Result,S}; - error:badarg -> - case erlang:get_stacktrace() of - [{erlang,apply, - [Module,State,[Type,Content,Data]=Args], - _} - |Stacktrace] - when CallbackMode =:= state_functions -> - %% We get here e.g if apply fails - %% due to State not being an atom - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - Stacktrace -> - {error,badarg,Stacktrace} - end; - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,State,[Type,Content,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= state_functions -> - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - [{Module,handle_event,[Type,Content,State,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= handle_event_function -> - {error, - {undef_state_function,{Module,handle_event,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. -- cgit v1.2.3 From 913d0b52df1e029fb1728b44ba7da318f3dc49dd Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 22 Feb 2017 15:41:26 +0100 Subject: Implement fallback for terminate/3 --- lib/stdlib/src/gen_statem.erl | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index d7e8504564..ae50651c06 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -289,6 +289,7 @@ -optional_callbacks( [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation + terminate/3, % Has got a default implementation %% state_name/3, % Example for callback_mode() =:= state_functions: %% there has to be a StateName/3 callback function @@ -1560,17 +1561,22 @@ terminate( Class, Reason, Stacktrace, Debug, #{module := Module, state := State, data := Data, postponed := P} = S, Q) -> - try Module:terminate(Reason, State, Data) of - _ -> ok - catch - _ -> ok; - C:R -> - ST = erlang:get_stacktrace(), - error_info( - C, R, ST, S, Q, P, - format_status(terminate, get(), S)), - sys:print_log(Debug), - erlang:raise(C, R, ST) + case erlang:function_exported(Module, terminate, 3) of + true -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), + erlang:raise(C, R, ST) + end; + false -> + ok end, _ = case Reason of -- cgit v1.2.3 From 0f587ce17f4ad292f6f2d23d6244426046134f38 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 22 Feb 2017 15:50:26 +0100 Subject: Make code_change/4 optional --- lib/stdlib/src/gen_statem.erl | 1 + 1 file changed, 1 insertion(+) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index ae50651c06..cacc932ec4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -290,6 +290,7 @@ [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation terminate/3, % Has got a default implementation + code_change/4, % Only needed by advanced soft upgrade %% state_name/3, % Example for callback_mode() =:= state_functions: %% there has to be a StateName/3 callback function -- cgit v1.2.3 From d30cae56d82763681b633cba25ad553eb672ec16 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 6 Apr 2017 16:09:38 +0200 Subject: Make Module:init/1 mandatory --- lib/stdlib/src/gen_statem.erl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index cacc932ec4..242ff87be7 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -287,8 +287,7 @@ StatusOption :: 'normal' | 'terminate'. -optional_callbacks( - [init/1, % One may use enter_loop/5,6,7 instead - format_status/2, % Has got a default implementation + [format_status/2, % Has got a default implementation terminate/3, % Has got a default implementation code_change/4, % Only needed by advanced soft upgrade %% -- cgit v1.2.3 From bca4b5c87fd1aae2fdcb78b605181393a0caf9d9 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 7 Feb 2017 22:38:36 +0100 Subject: Implement erlang:start_timer opts --- lib/stdlib/src/gen_statem.erl | 139 +++++++++++++++++++++++++++++++----------- 1 file changed, 105 insertions(+), 34 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 242ff87be7..fe80bb5de4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -97,13 +97,14 @@ %% If 'true' hibernate the server instead of going into receive boolean(). -type event_timeout() :: - %% Generate a ('timeout', EventContent, ...) event after Time + %% Generate a ('timeout', EventContent, ...) event %% unless some other event is delivered - Time :: timeout(). + Time :: timeout() | integer(). -type state_timeout() :: - %% Generate a ('state_timeout', EventContent, ...) event after Time + %% Generate a ('state_timeout', EventContent, ...) event %% unless the state is changed - Time :: timeout(). + Time :: timeout() | integer(). +-type timeout_option() :: {abs,Abs :: boolean()}. -type action() :: %% During a state change: @@ -137,8 +138,16 @@ (Timeout :: event_timeout()) | % {timeout,Timeout} {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | + {'timeout', % Set the event_timeout option + Time :: event_timeout(), + EventContent :: term(), + Options :: (timeout_option() | [timeout_option()])} | {'state_timeout', % Set the state_timeout option Time :: state_timeout(), EventContent :: term()} | + {'state_timeout', % Set the state_timeout option + Time :: state_timeout(), + EventContent :: term(), + Options :: (timeout_option() | [timeout_option()])} | %% reply_action(). -type reply_action() :: @@ -1312,7 +1321,7 @@ parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> parse_actions(Debug, S, State, Actions) -> Hibernate = false, - TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer + TimeoutsR = [infinity], %% Will cancel event timer Postpone = false, NextEventsR = [], parse_actions( @@ -1378,11 +1387,15 @@ parse_actions( ?STACKTRACE()} end; %% - {state_timeout,_,_} = Timeout -> + {TimerType,_,_} = Timeout + when TimerType =:= timeout; + TimerType =:= state_timeout -> parse_actions_timeout( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {timeout,_,_} = Timeout -> + {TimerType,_,_,_} = Timeout + when TimerType =:= timeout; + TimerType =:= state_timeout -> parse_actions_timeout( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); @@ -1395,26 +1408,64 @@ parse_actions( parse_actions_timeout( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> - Time = - case Timeout of - {_,T,_} -> T; - T -> T - end, - case validate_time(Time) of - true -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - false -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} + case Timeout of + {TimerType,Time,TimerMsg,TimerOpts} -> + case validate_timer_args(Time, listify(TimerOpts)) of + true -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + false -> + NewTimeout = {TimerType,Time,TimerMsg}, + parse_actions( + Debug, S, State, Actions, + Hibernate, [NewTimeout|TimeoutsR], + Postpone, NextEventsR); + error -> + {error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE()} + end; + {_,Time,_} -> + case validate_timer_args(Time, []) of + false -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + error -> + {error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE()} + end; + Time -> + case validate_timer_args(Time, []) of + false -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + error -> + {error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE()} + end end. -validate_time(Time) when is_integer(Time), Time >= 0 -> true; -validate_time(infinity) -> true; -validate_time(_) -> false. +validate_timer_args(Time, Opts) -> + validate_timer_args(Time, Opts, false). +%% +validate_timer_args(Time, [], true) when is_integer(Time) -> + true; +validate_timer_args(Time, [], false) when is_integer(Time), Time >= 0 -> + false; +validate_timer_args(infinity, [], Abs) -> + Abs; +validate_timer_args(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> + validate_timer_args(Time, Opts, Abs); +validate_timer_args(_, [_|_], _) -> + error. %% Stop and start timers as well as create timeout zero events %% and pending event timer @@ -1430,22 +1481,39 @@ parse_timers( TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> case Timeout of + {TimerType,Time,TimerMsg,TimerOpts} -> + %% Absolute timer + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg, listify(TimerOpts)); + %% Relative timers below + {TimerType,0,TimerMsg} -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, zero, TimerMsg, []); {TimerType,Time,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, - TimerType, Time, TimerMsg); + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg, []); + 0 -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + timeout, zero, 0, []); Time -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, - timeout, Time, Time) + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + timeout, Time, Time, []) end. parse_timers( TimerRefs, TimerTypes, CancelTimers, TimeoutsR, Seen, TimeoutEvents, - TimerType, Time, TimerMsg) -> + TimerType, Time, TimerMsg, TimerOpts) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore @@ -1464,7 +1532,7 @@ parse_timers( parse_timers( TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); - 0 -> + zero -> %% Cancel any running timer {NewTimerTypes,NewCancelTimers} = cancel_timer_by_type( @@ -1477,7 +1545,8 @@ parse_timers( _ -> %% (Re)start the timer TimerRef = - erlang:start_timer(Time, self(), TimerMsg), + erlang:start_timer( + Time, self(), TimerMsg, TimerOpts), case TimerTypes of #{TimerType := OldTimerRef} -> %% Cancel the running timer @@ -1491,6 +1560,8 @@ parse_timers( NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); #{} -> + %% Insert the new timer into + %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, TimerTypes#{TimerType => TimerRef}, -- cgit v1.2.3 From 30cae2492d8d8e927d57c0dc656ee2dfbec0a70c Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 13 Feb 2017 08:20:16 +0100 Subject: Implement {timeout,Name} timeouts --- lib/stdlib/src/gen_statem.erl | 79 +++++++++++++++++++++++++------------------ 1 file changed, 46 insertions(+), 33 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index fe80bb5de4..6f566b8beb 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -78,8 +78,9 @@ -type data() :: term(). -type event_type() :: - {'call',From :: from()} | 'cast' | - 'info' | 'timeout' | 'state_timeout' | 'internal'. + {'call',From :: from()} | 'cast' | 'info' | + 'timeout' | {'timeout', Name :: term()} | 'state_timeout' | + 'internal'. -type callback_mode_result() :: callback_mode() | [callback_mode() | state_enter()]. @@ -88,7 +89,7 @@ -type transition_option() :: postpone() | hibernate() | - event_timeout() | state_timeout(). + event_timeout() | generic_timeout() | state_timeout(). -type postpone() :: %% If 'true' postpone the current event %% and retry it when the state changes (=/=) @@ -100,6 +101,9 @@ %% Generate a ('timeout', EventContent, ...) event %% unless some other event is delivered Time :: timeout() | integer(). +-type generic_timeout() :: + %% Generate a ({'timeout',Name}, EventContent, ...) event + Time :: timeout() | integer(). -type state_timeout() :: %% Generate a ('state_timeout', EventContent, ...) event %% unless the state is changed @@ -142,6 +146,14 @@ Time :: event_timeout(), EventContent :: term(), Options :: (timeout_option() | [timeout_option()])} | + %% + {{'timeout', Name :: term()}, % Set the generic_timeout option + Time :: generic_timeout(), EventContent :: term()} | + {{'timeout', Name :: term()}, % Set the generic_timeout option + Time :: generic_timeout(), + EventContent :: term(), + Options :: (timeout_option() | [timeout_option()])} | + %% {'state_timeout', % Set the state_timeout option Time :: state_timeout(), EventContent :: term()} | {'state_timeout', % Set the state_timeout option @@ -311,37 +323,26 @@ %% Type validation functions callback_mode(CallbackMode) -> case CallbackMode of - state_functions -> - true; - handle_event_function -> - true; - _ -> - false + state_functions -> true; + handle_event_function -> true; + _ -> false end. %% -from({Pid,_}) when is_pid(Pid) -> - true; -from(_) -> - false. +from({Pid,_}) when is_pid(Pid) -> true; +from(_) -> false. %% event_type({call,From}) -> from(From); event_type(Type) -> case Type of - {call,From} -> - from(From); - cast -> - true; - info -> - true; - timeout -> - true; - state_timeout -> - true; - internal -> - true; - _ -> - false + {call,From} -> from(From); + cast -> true; + info -> true; + timeout -> true; + state_timeout -> true; + internal -> true; + {timeout,_} -> true; + _ -> false end. @@ -1387,15 +1388,27 @@ parse_actions( ?STACKTRACE()} end; %% - {TimerType,_,_} = Timeout - when TimerType =:= timeout; - TimerType =:= state_timeout -> + {{timeout,_},_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {{timeout,_},_,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {timeout,_,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {state_timeout,_,_} = Timeout -> parse_actions_timeout( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {TimerType,_,_,_} = Timeout - when TimerType =:= timeout; - TimerType =:= state_timeout -> + {state_timeout,_,_,_} = Timeout -> parse_actions_timeout( Debug, S, State, Actions, Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); -- cgit v1.2.3 From 063bebc88358f66cea17e3cf777b8b561a5f14c0 Mon Sep 17 00:00:00 2001 From: Anton N Ryabkov Date: Mon, 24 Apr 2017 12:54:09 +0700 Subject: Added support of auto_hibernate_timeout option for gen_statem. --- lib/stdlib/src/gen_statem.erl | 203 ++++++++++++++++++++++-------------------- 1 file changed, 108 insertions(+), 95 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6f566b8beb..2182b8d062 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -369,9 +369,12 @@ event_type(Type) -> Dbgs :: ['trace' | 'log' | 'statistics' | 'debug' | {'logfile', string()}]}. +-type auto_hibernate_timeout_opt() :: + {'auto_hibernate_timeout', AutoHibernateTimeout :: timeout()}. -type start_opt() :: debug_opt() | {'timeout', Time :: timeout()} + | auto_hibernate_timeout_opt() | {'spawn_opt', [proc_lib:spawn_option()]}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -544,14 +547,14 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% started by proc_lib into a state machine using %% the same arguments as you would have returned from init/1 -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data()) -> no_return(). enter_loop(Module, Opts, State, Data) -> enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> @@ -565,7 +568,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) -> end. %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> @@ -605,7 +608,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - Events = [], + AutoHibernateTimeout = gen:auto_hibernate_timeout(Opts), + Events = [], P = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that @@ -648,6 +652,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> timer_refs => TimerRefs, timer_types => TimerTypes, hibernate => Hibernate, + auto_hibernate_timeout => AutoHibernateTimeout, cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), @@ -854,109 +859,117 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, S) -> +loop_receive(Parent, Debug, #{cancel_timers := 0, auto_hibernate_timeout := AutoHibernateTimeout} = S) when is_integer(AutoHibernateTimeout) -> receive Msg -> - case Msg of - {system,Pid,Req} -> - #{hibernate := Hibernate} = S, - %% Does not return but tail recursively calls - %% system_continue/3 that jumps to loop/3 - sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, - Hibernate); - {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple therefore - %% not an event but this will stand out - %% in the crash report... - Q = [EXIT], - terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); - {timeout,TimerRef,TimerMsg} -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := TimerType} -> - %% We know of this timer; is it a running - %% timer or a timer being cancelled that - %% managed to send a late timeout message? - case TimerTypes of + handle_received_msg(Msg, Parent, Debug, S) + after + AutoHibernateTimeout -> + loop_hibernate(Parent, Debug, S) + end; +loop_receive(Parent, Debug, S) -> + receive + Msg -> + handle_received_msg(Msg, Parent, Debug, S) + end. + +handle_received_msg({system,Pid,Req}, Parent, Debug, S) -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, + Hibernate); +handle_received_msg({'EXIT',Parent,Reason} = EXIT, Parent, Debug, S) -> + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); +handle_received_msg({timeout,TimerRef,TimerMsg} = Msg, Parent, Debug, S) -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := TimerType} -> + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of #{TimerType := TimerRef} -> - %% The timer type maps back to this - %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewTimerTypes = - maps:remove(TimerType, TimerTypes), - loop_receive_result( - Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); _ -> - %% This was a late timeout message - %% from timer being cancelled, so - %% ignore it and expect a cancel_timer - %% msg shortly - loop_receive(Parent, Debug, S) - end; - _ -> - %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; - {cancel_timer,TimerRef,_} -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := _} -> - %% We must have requested a cancel - %% of this timer so it is already - %% removed from TimerTypes - NewTimerRefs = + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; +handle_received_msg({cancel_timer,TimerRef,_} = Msg, Parent, Debug, S) -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = maps:remove(TimerRef, TimerRefs), - NewCancelTimers = CancelTimers - 1, - NewS = + NewCancelTimers = CancelTimers - 1, + NewS = S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, - if + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if Hibernate =:= true, NewCancelTimers =:= 0 -> - %% No more cancel_timer msgs to expect; - %% we can hibernate - loop_hibernate(Parent, Debug, NewS); + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); NewCancelTimers >= 0 -> % Assert - loop_receive(Parent, Debug, NewS) - end; - _ -> - %% Not our cancel_timer msg; - %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; + loop_receive(Parent, Debug, NewS) + end; _ -> - %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> + %% Not our cancel_timer msg; + %% present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; +handle_received_msg(Msg, Parent, Debug, S) -> + %% External msg + #{hibernate := Hibernate} = S, + Event = + case Msg of + {'$gen_call',From,Request} -> {{call,From},Request}; - {'$gen_cast',E} -> + {'$gen_cast',E} -> {cast,E}; - _ -> + _ -> {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end - end. + end, + loop_receive_result( + Parent, Debug, S, Hibernate, Event). loop_receive_result( Parent, Debug, -- cgit v1.2.3 From 38294da512781e44b44b9331bf613003397d529b Mon Sep 17 00:00:00 2001 From: Anton N Ryabkov Date: Mon, 24 Apr 2017 13:41:59 +0700 Subject: "auto_hibernate_timeout" option renamed to "hibernate_after". It was done because "hibernate_after" option already used in ssl for the same reason. --- lib/stdlib/src/gen_statem.erl | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 2182b8d062..5dc9cca76e 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -369,12 +369,12 @@ event_type(Type) -> Dbgs :: ['trace' | 'log' | 'statistics' | 'debug' | {'logfile', string()}]}. --type auto_hibernate_timeout_opt() :: - {'auto_hibernate_timeout', AutoHibernateTimeout :: timeout()}. +-type hibernate_after_opt() :: + {'hibernate_after', HibernateAfterTimeout :: timeout()}. -type start_opt() :: debug_opt() | {'timeout', Time :: timeout()} - | auto_hibernate_timeout_opt() + | hibernate_after_opt() | {'spawn_opt', [proc_lib:spawn_option()]}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -547,14 +547,14 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% started by proc_lib into a state machine using %% the same arguments as you would have returned from init/1 -spec enter_loop( - Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data()) -> no_return(). enter_loop(Module, Opts, State, Data) -> enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> @@ -568,7 +568,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) -> end. %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> @@ -608,7 +608,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - AutoHibernateTimeout = gen:auto_hibernate_timeout(Opts), + HibernateAfterTimeout = gen:hibernate_after(Opts), Events = [], P = [], Event = {internal,init_state}, @@ -652,7 +652,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> timer_refs => TimerRefs, timer_types => TimerTypes, hibernate => Hibernate, - auto_hibernate_timeout => AutoHibernateTimeout, + hibernate_after => HibernateAfterTimeout, cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), @@ -859,12 +859,12 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{cancel_timers := 0, auto_hibernate_timeout := AutoHibernateTimeout} = S) when is_integer(AutoHibernateTimeout) -> +loop_receive(Parent, Debug, #{cancel_timers := 0, hibernate_after := HibernateAfterTimeout} = S) when is_integer(HibernateAfterTimeout) -> receive Msg -> handle_received_msg(Msg, Parent, Debug, S) after - AutoHibernateTimeout -> + HibernateAfterTimeout -> loop_hibernate(Parent, Debug, S) end; loop_receive(Parent, Debug, S) -> -- cgit v1.2.3 From bf3ead6cdb3a5c7556831b9684574845101f4f36 Mon Sep 17 00:00:00 2001 From: Anton N Ryabkov Date: Tue, 25 Apr 2017 18:27:15 +0700 Subject: Rolled back loop_receive function. HibernateAfterTimeout timeout used even in case of active timers exists. Added unit tests for hibernate_after functionality combined with gen_statem timers. --- lib/stdlib/src/gen_statem.erl | 193 ++++++++++++++++++++---------------------- 1 file changed, 94 insertions(+), 99 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 5dc9cca76e..86109f04b4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -859,117 +859,112 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{cancel_timers := 0, hibernate_after := HibernateAfterTimeout} = S) when is_integer(HibernateAfterTimeout) -> +loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> receive Msg -> - handle_received_msg(Msg, Parent, Debug, S) - after - HibernateAfterTimeout -> - loop_hibernate(Parent, Debug, S) - end; -loop_receive(Parent, Debug, S) -> - receive - Msg -> - handle_received_msg(Msg, Parent, Debug, S) - end. - -handle_received_msg({system,Pid,Req}, Parent, Debug, S) -> - #{hibernate := Hibernate} = S, - %% Does not return but tail recursively calls - %% system_continue/3 that jumps to loop/3 - sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, - Hibernate); -handle_received_msg({'EXIT',Parent,Reason} = EXIT, Parent, Debug, S) -> - %% EXIT is not a 2-tuple therefore - %% not an event but this will stand out - %% in the crash report... - Q = [EXIT], - terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); -handle_received_msg({timeout,TimerRef,TimerMsg} = Msg, Parent, Debug, S) -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := TimerType} -> - %% We know of this timer; is it a running - %% timer or a timer being cancelled that - %% managed to send a late timeout message? - case TimerTypes of + case Msg of + {system,Pid,Req} -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, + Hibernate); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); + {timeout,TimerRef,TimerMsg} -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := TimerType} -> + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of #{TimerType := TimerRef} -> - %% The timer type maps back to this - %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewTimerTypes = - maps:remove(TimerType, TimerTypes), - loop_receive_result( - Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); _ -> - %% This was a late timeout message - %% from timer being cancelled, so - %% ignore it and expect a cancel_timer - %% msg shortly - loop_receive(Parent, Debug, S) - end; - _ -> - %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; -handle_received_msg({cancel_timer,TimerRef,_} = Msg, Parent, Debug, S) -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := _} -> - %% We must have requested a cancel - %% of this timer so it is already - %% removed from TimerTypes - NewTimerRefs = + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; + {cancel_timer,TimerRef,_} -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = maps:remove(TimerRef, TimerRefs), - NewCancelTimers = CancelTimers - 1, - NewS = + NewCancelTimers = CancelTimers - 1, + NewS = S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, - if + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if Hibernate =:= true, NewCancelTimers =:= 0 -> - %% No more cancel_timer msgs to expect; - %% we can hibernate - loop_hibernate(Parent, Debug, NewS); + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); NewCancelTimers >= 0 -> % Assert - loop_receive(Parent, Debug, NewS) - end; + loop_receive(Parent, Debug, NewS) + end; + _ -> + %% Not our cancel_timer msg; + %% present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; _ -> - %% Not our cancel_timer msg; - %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; -handle_received_msg(Msg, Parent, Debug, S) -> - %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> + %% External msg + #{hibernate := Hibernate} = S, + Event = + case Msg of + {'$gen_call',From,Request} -> {{call,From},Request}; - {'$gen_cast',E} -> + {'$gen_cast',E} -> {cast,E}; - _ -> + _ -> {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event). + end, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end + after + HibernateAfterTimeout -> + loop_hibernate(Parent, Debug, S) + end. loop_receive_result( Parent, Debug, -- cgit v1.2.3 From 0b1fe37dbcfaad9b28ef529aa4f7b4be60ec5da8 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 18 May 2017 10:16:52 +0200 Subject: stdlib: Limit the size of gen_statem's error events The postponed events, the user state and data, and the error reason are all limited in error events (if the Kernel variable error_logger_format_depth is set). --- lib/stdlib/src/gen_statem.erl | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 86109f04b4..b5e9da1e66 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1722,6 +1722,8 @@ error_info( end; _ -> {Reason,Stacktrace} end, + [LimitedP, LimitedFmtData, LimitedFixedReason] = + [error_logger:limit_term(D) || D <- [P, FmtData, FixedReason]], CBMode = case StateEnter of true -> @@ -1755,8 +1757,8 @@ error_info( [] -> []; [Event|_] -> [Event] end] ++ - [FmtData, - Class,FixedReason, + [LimitedFmtData, + Class,LimitedFixedReason, CBMode] ++ case Q of [_|[_|_] = Events] -> [Events]; @@ -1764,7 +1766,7 @@ error_info( end ++ case P of [] -> []; - _ -> [P] + _ -> [LimitedP] end ++ case FixedStacktrace of [] -> []; -- cgit v1.2.3