From 063bebc88358f66cea17e3cf777b8b561a5f14c0 Mon Sep 17 00:00:00 2001 From: Anton N Ryabkov Date: Mon, 24 Apr 2017 12:54:09 +0700 Subject: Added support of auto_hibernate_timeout option for gen_statem. --- lib/stdlib/src/gen_statem.erl | 203 ++++++++++++++++++++++-------------------- 1 file changed, 108 insertions(+), 95 deletions(-) (limited to 'lib/stdlib/src/gen_statem.erl') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6f566b8beb..2182b8d062 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -369,9 +369,12 @@ event_type(Type) -> Dbgs :: ['trace' | 'log' | 'statistics' | 'debug' | {'logfile', string()}]}. +-type auto_hibernate_timeout_opt() :: + {'auto_hibernate_timeout', AutoHibernateTimeout :: timeout()}. -type start_opt() :: debug_opt() | {'timeout', Time :: timeout()} + | auto_hibernate_timeout_opt() | {'spawn_opt', [proc_lib:spawn_option()]}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -544,14 +547,14 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% started by proc_lib into a state machine using %% the same arguments as you would have returned from init/1 -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data()) -> no_return(). enter_loop(Module, Opts, State, Data) -> enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> @@ -565,7 +568,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) -> end. %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | auto_hibernate_timeout_opt()], State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> @@ -605,7 +608,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - Events = [], + AutoHibernateTimeout = gen:auto_hibernate_timeout(Opts), + Events = [], P = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that @@ -648,6 +652,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> timer_refs => TimerRefs, timer_types => TimerTypes, hibernate => Hibernate, + auto_hibernate_timeout => AutoHibernateTimeout, cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), @@ -854,109 +859,117 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, S) -> +loop_receive(Parent, Debug, #{cancel_timers := 0, auto_hibernate_timeout := AutoHibernateTimeout} = S) when is_integer(AutoHibernateTimeout) -> receive Msg -> - case Msg of - {system,Pid,Req} -> - #{hibernate := Hibernate} = S, - %% Does not return but tail recursively calls - %% system_continue/3 that jumps to loop/3 - sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, - Hibernate); - {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple therefore - %% not an event but this will stand out - %% in the crash report... - Q = [EXIT], - terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); - {timeout,TimerRef,TimerMsg} -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := TimerType} -> - %% We know of this timer; is it a running - %% timer or a timer being cancelled that - %% managed to send a late timeout message? - case TimerTypes of + handle_received_msg(Msg, Parent, Debug, S) + after + AutoHibernateTimeout -> + loop_hibernate(Parent, Debug, S) + end; +loop_receive(Parent, Debug, S) -> + receive + Msg -> + handle_received_msg(Msg, Parent, Debug, S) + end. + +handle_received_msg({system,Pid,Req}, Parent, Debug, S) -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, + Hibernate); +handle_received_msg({'EXIT',Parent,Reason} = EXIT, Parent, Debug, S) -> + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); +handle_received_msg({timeout,TimerRef,TimerMsg} = Msg, Parent, Debug, S) -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := TimerType} -> + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of #{TimerType := TimerRef} -> - %% The timer type maps back to this - %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewTimerTypes = - maps:remove(TimerType, TimerTypes), - loop_receive_result( - Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); _ -> - %% This was a late timeout message - %% from timer being cancelled, so - %% ignore it and expect a cancel_timer - %% msg shortly - loop_receive(Parent, Debug, S) - end; - _ -> - %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; - {cancel_timer,TimerRef,_} -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, - case TimerRefs of - #{TimerRef := _} -> - %% We must have requested a cancel - %% of this timer so it is already - %% removed from TimerTypes - NewTimerRefs = + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; +handle_received_msg({cancel_timer,TimerRef,_} = Msg, Parent, Debug, S) -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = maps:remove(TimerRef, TimerRefs), - NewCancelTimers = CancelTimers - 1, - NewS = + NewCancelTimers = CancelTimers - 1, + NewS = S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, - if + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if Hibernate =:= true, NewCancelTimers =:= 0 -> - %% No more cancel_timer msgs to expect; - %% we can hibernate - loop_hibernate(Parent, Debug, NewS); + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); NewCancelTimers >= 0 -> % Assert - loop_receive(Parent, Debug, NewS) - end; - _ -> - %% Not our cancel_timer msg; - %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end; + loop_receive(Parent, Debug, NewS) + end; _ -> - %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> + %% Not our cancel_timer msg; + %% present it as an event + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, Hibernate, Event) + end; +handle_received_msg(Msg, Parent, Debug, S) -> + %% External msg + #{hibernate := Hibernate} = S, + Event = + case Msg of + {'$gen_call',From,Request} -> {{call,From},Request}; - {'$gen_cast',E} -> + {'$gen_cast',E} -> {cast,E}; - _ -> + _ -> {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) - end - end. + end, + loop_receive_result( + Parent, Debug, S, Hibernate, Event). loop_receive_result( Parent, Debug, -- cgit v1.2.3