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') 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') 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') 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') 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') 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') 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') 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') 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') 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') 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') 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') 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