From 32485c0499a0893b4fb69c6e26d91b4303cb1cba Mon Sep 17 00:00:00 2001
From: Raimo Niskanen <raimo@erlang.org>
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')
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.
</p>
<p>
If the value is <c>infinity</c>, 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