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/doc/src/gen_statem.xml | 8 ++++---- lib/stdlib/src/gen_statem.erl | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) (limited to 'lib/stdlib') diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 64267c2af5..fb1e4e8da2 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -533,7 +533,7 @@ handle_event(_, _, State, Data) -> Type info originates from regular process messages sent to the gen_statem. Also, the state machine implementation can generate events of types - timeout, state_timeout, enter, + timeout, state_timeout, and internal to itself.

@@ -1773,7 +1773,7 @@ handle_event(_, _, State, Data) -> StateFunctionResult Module:handle_event(enter, OldState, State, Data) -> - StateEnterResult + StateEnterResult(State) Module:handle_event(EventType, EventContent, State, Data) -> HandleEventResult @@ -1802,8 +1802,8 @@ handle_event(_, _, State, Data) -> event_handler_result(state_name()) - StateEnterResult = - state_enter_result(state()) + StateEnterResult(State) = + state_enter_result(State) HandleEventResult = 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/doc/src/gen_statem.xml | 66 ++-- lib/stdlib/src/gen_statem.erl | 602 ++++++++++++++++++----------------- lib/stdlib/test/gen_statem_SUITE.erl | 30 +- 3 files changed, 364 insertions(+), 334 deletions(-) (limited to 'lib/stdlib') diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index fb1e4e8da2..567130875a 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -638,6 +638,20 @@ handle_event(_, _, State, Data) -> and they modify how the state transition is done:

+ +

+ If the state changes or is the initial state, and + state enter calls + are used, the gen_statem calls + the new state callback with arguments + (enter, OldState, Data). + Any + actions + returned from this call are handled as if they were + appended to the actions + returned by the state callback that changed states. +

+

All @@ -667,37 +681,37 @@ handle_event(_, _, State, Data) -> are inserted to be processed before the other queued events.

- -

- If the state changes or is the initial state, and - state enter calls - are used, the gen_statem calls - the new state callback with arguments - (enter, OldState, Data). - Any - actions - returned from this call are handled as if they were - appended to the actions - returned by the state callback that changed states. -

- - -

- If there are enqueued events the (possibly new) - state callback - is called with the oldest enqueued event, - and we start again from the top of this list. -

-

Timeout timers state_timeout() and event_timeout() - are handled. This may lead to a time-out zero event - being generated to the + are handled. Time-outs with zero time are guaranteed to be + delivered to the state machine before any external + not yet received event so if there is such a timeout requested, + the corresponding time-out zero event is enqueued as + the newest event. +

+

+ Any event cancels an + event_timeout() + so a zero time event time-out is only generated + if the event queue is empty. +

+

+ A state change cancels a + state_timeout() + and any new transition option of this type + belongs to the new state. +

+ + +

+ If there are enqueued events the state callback + for the possibly new state + is called with the oldest enqueued event, and we start again from the top of this list.

@@ -802,7 +816,7 @@ handle_event(_, _, State, Data) ->

Setting this timer while it is running will restart it with the new time-out value. Therefore it is possible to cancel - this timeout by setting it to infinity. + this time-out by setting it to infinity.

@@ -1130,7 +1144,7 @@ handle_event(_, _, State, Data) -> Timeout can also be a tuple {clean_timeout,T} or {dirty_timeout,T}, where - T is the timeout time. + T is the time-out time. {clean_timeout,T} works like just T described in the note above and uses a proxy process for T < infinity, 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 -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 28f9ab81fe..119546be98 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -742,26 +742,40 @@ state_timeout(_Config) -> %% Verify that {state_timeout,0,_} %% comes after next_event and that %% {timeout,0,_} is cancelled by - %% {state_timeout,0,_} + %% pending {state_timeout,0,_} {keep_state, {ok,2,Data}, [{timeout,0,3}]}; - (state_timeout, 2, {ok,2,{Time,From}}) -> - {next_state, state3, 3, + (state_timeout, 2, {ok,2,Data}) -> + %% Verify that timeout 0's are processed + %% in order + {keep_state, {ok,3,Data}, + [{timeout,0,4},{state_timeout,0,5}]}; + (timeout, 4, {ok,3,Data}) -> + %% Verify that timeout 0 is cancelled by + %% enqueued state_timeout 0 and that + %% multiple state_timeout 0 can be enqueued + {keep_state, {ok,4,Data}, + [{state_timeout,0,6},{timeout,0,7}]}; + (state_timeout, 5, {ok,4,Data}) -> + {keep_state, {ok,5,Data}}; + (state_timeout, 6, {ok,5,{Time,From}}) -> + {next_state, state3, 6, [{reply,From,ok}, - {state_timeout,Time,3}]} + {state_timeout,Time,8}]} end, state3 => fun - (info, message_to_self, 3) -> - {keep_state, '3'}; - ({call,From}, check, '3') -> + (info, message_to_self, 6) -> + {keep_state, 7}; + ({call,From}, check, 7) -> {keep_state, From}; - (state_timeout, 3, From) -> + (state_timeout, 8, From) -> {stop_and_reply, normal, {reply,From,ok}} end}, {ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine,[]}, []), + sys:trace(STM, true), TRef = erlang:start_timer(1000, self(), kull), ok = gen_statem:call(STM, {go,500}), ok = gen_statem:call(STM, check), -- 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/doc/src/gen_statem.xml | 5 +- lib/stdlib/src/gen_statem.erl | 116 ++++++++++++++++++++++++-------------- 2 files changed, 77 insertions(+), 44 deletions(-) (limited to 'lib/stdlib') diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 567130875a..fd498ee82e 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -773,8 +773,9 @@ handle_event(_, _, State, Data) -> after this time (in milliseconds) unless another event arrives or has arrived in which case this time-out is cancelled. - Note that a retried, inserted or state time-out zero - events counts as arrived. + Note that a retried or inserted event counts as arrived. + So does a state time-out zero event, if it was generated + before this timer is requested.

If the value is infinity, no timer is started, as 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') 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