File 3341-Implement-zero-time-outs-with-dedicated-queue.patch of Package erlang

From 6db46e96d5fc3f10d37c6c4ba4f6a211a663d971 Mon Sep 17 00:00:00 2001
From: Raimo Niskanen <raimo@erlang.org>
Date: Sat, 17 Oct 2020 01:22:33 +0200
Subject: [PATCH] Implement zero time-outs with dedicated queue

The previous solution was flawed because it immediately inserted
a zero time-out in the event queue, and tried to compensate for
when and how they would not fire due to state changes and other
events.

That implementation did not cut it e.g when combining a state
time-out with inserting an event, and in the new state, with
the state time-out, changing states.  Then the state time-out
was not cancelled because it was already in the event queue,
and it arrived in a later state.

This commit changes the implementation into having a dedicated
queue for zero time-outs, from which events are extracted
as from the process mailbox, but before the process mailbox.
Now when cancelling a time-out, for any reason, automatic
or explicit, a zero time-out can be removed from this queue
as it would have been from the process mailbox for time > 0.

With this implementation it should be guaranteed that
a state time-out is delivered only in the state for which
it was started.  A state change can always cancel it when it
is in the dedicated queue.

The queue is stored in the Timers map, with the specical key 't0q',
that does not collide with any timeout_event_type(), but needs to
be handled in a few places to protect form abuse and to correct
the time-out count.  Having it here allows for cancel_timeout/2,3
to still operate on only the Timers map, and does not cause
unnecessary rebuild of terms when updating timers
and not having any zero time-outs.
---
 lib/stdlib/src/gen_statem.erl        | 279 +++++++++++++--------------
 lib/stdlib/test/gen_statem_SUITE.erl |   8 +-
 2 files changed, 139 insertions(+), 148 deletions(-)

diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index adf1a82a08..b15b404ac9 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -444,10 +444,18 @@ timeout_event_type(Type) ->
         {state_data = {undefined,undefined} ::
            {State :: term(),Data :: term()},
          postponed = [] :: [{event_type(),term()}],
-         timers = #{} ::
-           #{TimeoutType :: timeout_event_type() =>
-                            {TimerRef :: reference(), TimeoutMsg :: term()}},
-          hibernate = false :: boolean()
+         timers = #{t0q => []} ::
+           #{
+              %% Timeout 0 Queue.
+              %% Marked in the table with TimerRef = 0.
+              %% Stored here because they also are updated
+              %% by e.g cancel_timer/3.
+              't0q' := [timeout_event_type()],
+
+              TimeoutType :: timeout_event_type() =>
+                             {TimerRef :: reference() | 0,
+                              TimeoutMsg :: term()}},
+         hibernate = false :: boolean()
         }).
 
 %%%==========================================================================
@@ -1017,7 +1025,8 @@ loop_receive(
                 %%
 		{timeout,TimerRef,TimeoutType} ->
                     case S#state.timers of
-                        #{TimeoutType := {TimerRef,TimeoutMsg}} = Timers ->
+                        #{TimeoutType := {TimerRef,TimeoutMsg}} = Timers
+                          when TimeoutType =/= t0q->
                             %% Our timer
                             Timers_1 = maps:remove(TimeoutType, Timers),
                             S_1 = S#state{timers = Timers_1},
@@ -1845,6 +1854,9 @@ loop_keep_state(
     %% Cancel event timeout
     %%
     case Timers of
+	%% Optimization
+	%% - only cancel timeout when it is active
+	%%
         #{timeout := {TimerRef,_TimeoutMsg}} ->
 	    %% Event timeout active
 	    loop_next_events(
@@ -1885,7 +1897,7 @@ loop_state_change(
               P, Debug, S,
               [E1,E2|Events], NextState_NewData,
               NextEventsR, Hibernate, TimeoutsR);
-        _ ->
+        [_,_|_] ->
             loop_state_change(
               P, Debug, S,
               lists:reverse(Postponed, Events), NextState_NewData,
@@ -1937,7 +1949,7 @@ loop_next_events(
   Timers) ->
     %%
     %% Optimization when there are no timeouts
-    %% hence no timeout zero events to append to Events
+    %% hence no zero timeout events to append to Events
     %% - avoid loop_timeouts
     loop_done(
       P, Debug,
@@ -1946,7 +1958,7 @@ loop_next_events(
 	postponed = Postponed,
         timers = Timers,
 	hibernate = Hibernate},
-      NextEventsR, Events);
+      Events, NextEventsR);
 loop_next_events(
   P, Debug, S,
   Events, NextState_NewData,
@@ -1972,34 +1984,24 @@ loop_timeouts(
     %%
     %% End of timeouts
     %%
-    S_1 =
-        S#state{
-          state_data = NextState_NewData,
-          postponed = Postponed,
-          timers = Timers,
-          hibernate = Hibernate},
     case TimeoutEvents of
         [] ->
-            loop_done(P, Debug, S_1, NextEventsR, Events);
-        _ ->
-            case Events of
-                [] ->
-                    loop_prepend_timeout_events(
-                      P, Debug, S_1, TimeoutEvents,
-                      NextEventsR);
-                [E1] ->
-                    loop_prepend_timeout_events(
-                      P, Debug, S_1, TimeoutEvents,
-                      [E1|NextEventsR]);
-                [E2,E1] ->
-                    loop_prepend_timeout_events(
-                      P, Debug, S_1, TimeoutEvents,
-                      [E1,E2|NextEventsR]);
-                _ ->
-                    loop_prepend_timeout_events(
-                      P, Debug, S_1, TimeoutEvents,
-                      lists:reverse(Events, NextEventsR))
-            end
+            S_1 =
+                S#state{
+                  state_data = NextState_NewData,
+                  postponed = Postponed,
+                  timers = Timers,
+                  hibernate = Hibernate},
+            loop_done(P, Debug, S_1, Events, NextEventsR);
+        [_|_] ->
+            #{t0q := T0Q} = Timers,
+            S_1 =
+                S#state{
+                  state_data = NextState_NewData,
+                  postponed = Postponed,
+                  timers = Timers#{t0q := T0Q ++ TimeoutEvents},
+                  hibernate = Hibernate},
+            loop_done(P, Debug, S_1, Events, NextEventsR)
     end;
 loop_timeouts(
   P, Debug, S,
@@ -2055,17 +2057,6 @@ loop_timeouts_start(
               NextEventsR, Hibernate, TimeoutsR, Postponed,
               Timers, Seen, TimeoutEvents,
               TimeoutType);
-        0 when TimeoutOpts =:= [] ->
-            %% Relative timeout zero
-            %% - cancel any running timer
-            %%   handle timeout zero events later
-            %%
-            loop_timeouts_cancel(
-              P, Debug, S,
-              Events, NextState_NewData,
-              NextEventsR, Hibernate, TimeoutsR, Postponed,
-              Timers, Seen, [{TimeoutType,TimeoutMsg}|TimeoutEvents],
-              TimeoutType);
         update ->
             loop_timeouts_update(
               P, Debug, S,
@@ -2073,36 +2064,60 @@ loop_timeouts_start(
               NextEventsR, Hibernate, TimeoutsR, Postponed,
               Timers, Seen, TimeoutEvents,
               TimeoutType, TimeoutMsg);
+        0 ->
+            %% (Re)start zero timeout
+            TimerRef = 0,
+            TimeoutEvents_1 = [TimeoutType | TimeoutEvents],
+            loop_timeouts_register(
+              P, Debug, S,
+              Events, NextState_NewData,
+              NextEventsR, Hibernate, TimeoutsR, Postponed,
+              Timers, Seen, TimeoutEvents_1,
+              TimeoutType, Time, TimeoutMsg, TimeoutOpts, TimerRef);
         _ ->
             %% (Re)start the timer
             TimerRef =
                 erlang:start_timer(Time, self(), TimeoutType, TimeoutOpts),
-            case Debug of
-                ?not_sys_debug ->
-                    loop_timeouts_register(
-                      P, Debug, S, Events, NextState_NewData,
-                      NextEventsR, Hibernate, TimeoutsR, Postponed,
-                      Timers, Seen, TimeoutEvents,
-                      TimeoutType, TimerRef, TimeoutMsg);
-                _ ->
-                    {State,_Data} = NextState_NewData,
-                    Debug_1 =
-                        sys_debug(
-                          Debug, P#params.name,
-                          {start_timer,
-                           {TimeoutType,Time,TimeoutMsg,TimeoutOpts},
-                           State}),
-                    loop_timeouts_register(
-                      P, Debug_1, S, Events, NextState_NewData,
-                      NextEventsR, Hibernate, TimeoutsR, Postponed,
-                      Timers, Seen, TimeoutEvents,
-                      TimeoutType, TimerRef, TimeoutMsg)
-            end
+            loop_timeouts_register(
+              P, Debug, S,
+              Events, NextState_NewData,
+              NextEventsR, Hibernate, TimeoutsR, Postponed,
+              Timers, Seen, TimeoutEvents,
+              TimeoutType, Time, TimeoutMsg, TimeoutOpts, TimerRef)
     end.
 
 %% Loop helper to register a newly started timer
 %% and to cancel any running timer
 %%
+loop_timeouts_register(
+  P, Debug, S,
+  Events, NextState_NewData,
+  NextEventsR, Hibernate, TimeoutsR, Postponed,
+  Timers, Seen, TimeoutEvents,
+  TimeoutType, Time, TimeoutMsg, TimeoutOpts, TimerRef) ->
+    %%
+    case Debug of
+        ?not_sys_debug ->
+            loop_timeouts_register(
+              P, Debug, S, Events, NextState_NewData,
+              NextEventsR, Hibernate, TimeoutsR, Postponed,
+              Timers, Seen, TimeoutEvents,
+              TimeoutType, TimerRef, TimeoutMsg);
+        _ ->
+            {State,_Data} = NextState_NewData,
+            Debug_1 =
+                sys_debug(
+                  Debug, P#params.name,
+                  {start_timer,
+                   {TimeoutType,Time,TimeoutMsg,TimeoutOpts},
+                   State}),
+            loop_timeouts_register(
+              P, Debug_1, S, Events, NextState_NewData,
+              NextEventsR, Hibernate, TimeoutsR, Postponed,
+              Timers, Seen, TimeoutEvents,
+              TimeoutType, TimerRef, TimeoutMsg)
+    end.
+%%
 loop_timeouts_register(
   P, Debug, S, Events, NextState_NewData,
   NextEventsR, Hibernate, TimeoutsR, Postponed,
@@ -2110,6 +2125,19 @@ loop_timeouts_register(
   TimeoutType, TimerRef, TimeoutMsg) ->
     %%
     case Timers of
+        #{TimeoutType := {0,_OldTimeoutMsg},
+          t0q := T0Q} ->
+            %% Cancel the running timer,
+            %% and update timer type and ref
+            Timers_1 =
+                Timers
+                #{TimeoutType := {0,TimeoutMsg},
+                  t0q := lists:delete(TimeoutType, T0Q)},
+            loop_timeouts(
+              P, Debug, S,
+              Events, NextState_NewData,
+              NextEventsR, Hibernate, TimeoutsR, Postponed,
+              Timers_1, Seen#{TimeoutType => true}, TimeoutEvents);
         #{TimeoutType := {OldTimerRef,_OldTimeoutMsg}} ->
             %% Cancel the running timer,
             %% and update timer type and ref
@@ -2147,7 +2175,7 @@ loop_timeouts_cancel(
     %%
     %% Explicitly separate cases to get separate code paths for when
     %% the map key exists vs. not, since otherwise the external call
-    %% to erlang:cancel_timer/1 and to map:remove/2 within
+    %% to erlang:cancel_timer/1 and to maps:remove/2 within
     %% cancel_timer/2 would cause all live registers
     %% to be saved to and restored from the stack also for
     %% the case when the map key TimeoutType does not exist
@@ -2168,7 +2196,7 @@ loop_timeouts_cancel(
     end.
 
 %% Loop helper to update the timeout message,
-%% or insert an event if no timer is running
+%% or start a zero timeout if no timer is running
 %%
 loop_timeouts_update(
   P, Debug, S,
@@ -2187,27 +2215,19 @@ loop_timeouts_update(
               Timers_1, Seen#{TimeoutType => true},
               TimeoutEvents);
         #{} ->
-            TimeoutEvents_1 =
-                [{TimeoutType,TimeoutMsg}|TimeoutEvents],
+            Timers_1 = Timers#{TimeoutType => {0, TimeoutMsg}},
+            TimeoutEvents_1 = [TimeoutType|TimeoutEvents],
             loop_timeouts(
               P, Debug, S,
               Events, NextState_NewData,
               NextEventsR, Hibernate, TimeoutsR, Postponed,
-              Timers, Seen#{TimeoutType => true},
+              Timers_1, Seen#{TimeoutType => true},
               TimeoutEvents_1)
     end.
 
-%% Continue state transition with prepending timeout zero events
-%% before event queue reversal i.e appending timeout zero events
-%%
-loop_prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR) ->
-    {Debug_1,Events_1R} =
-        prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR),
-    loop_done(P, Debug_1, S, Events_1R, []).
-
 %% Place inserted events first in the event queue
 %%
-loop_done(P, Debug, S, NextEventsR, Events) ->
+loop_done(P, Debug, S, Events, NextEventsR) ->
     case NextEventsR of
         [] ->
             loop_done(P, Debug, S, Events);
@@ -2215,12 +2235,13 @@ loop_done(P, Debug, S, NextEventsR, Events) ->
             loop_done(P, Debug, S, [E1|Events]);
         [E2,E1] ->
             loop_done(P, Debug, S, [E1,E2|Events]);
-        _ ->
+        [_,_|_] ->
             loop_done(P, Debug, S, lists:reverse(NextEventsR, Events))
     end.
 %%
 %% State transition is done, keep looping if there are
-%% enqueued events, otherwise get a new event
+%% enqueued events, or if there are zero timeouts,
+%% otherwise get a new event
 %%
 loop_done(P, Debug, S, Q) ->
 %%%    io:format(
@@ -2230,13 +2251,23 @@ loop_done(P, Debug, S, Q) ->
 %%%      [S#state.state_data,,S#state.postponed,Q,S#state.timers]),
     case Q of
         [] ->
-            %% Get a new event
-            loop(P, Debug, S);
+            case S#state.timers of
+                #{t0q := [TimeoutType|_]} = Timers ->
+                    #{TimeoutType := {0 = TimerRef, TimeoutMsg}} = Timers,
+                    Timers_1 = cancel_timer(TimeoutType, TimerRef, Timers),
+                    S_1 = S#state{timers = Timers_1},
+                    Event = {TimeoutType, TimeoutMsg},
+                    loop_receive_result(P, Debug, S_1, Event);
+                #{} ->
+                    %% Get a new event
+                    loop(P, Debug, S)
+            end;
         [Event|Events] ->
 	    %% Loop until out of enqueued events
 	    loop_event(P, Debug, S, Event, Events)
     end.
 
+
 %%---------------------------------------------------------------------------
 %% Server loop helpers
 
@@ -2256,58 +2287,6 @@ parse_timeout_opts_abs(Opts, Abs) ->
             badarg
     end.
 
-%% Enqueue immediate timeout events (timeout 0 events)
-%%
-%% Event timeout 0 events gets special treatment since
-%% an event timeout is cancelled by any received event,
-%% so if there are enqueued events before the event
-%% timeout 0 event - the event timeout is cancelled hence no event.
-%%
-%% Other (state_timeout and {timeout,Name}) timeout 0 events
-%% that occur after an event timer timeout 0 event 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(_P, Debug, _S, [], EventsR) ->
-    {Debug,EventsR};
-prepend_timeout_events(
-  P, Debug, S, [{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
-    %% Prepend this since there are no other events in queue
-    case Debug of
-        ?not_sys_debug ->
-            prepend_timeout_events(
-              P, Debug, S, TimeoutEvents, [TimeoutEvent]);
-        _ ->
-            {State,_Data} = S#state.state_data,
-            Debug_1 =
-              sys_debug(
-                Debug, P#params.name,
-                {insert_timeout,TimeoutEvent,State}),
-            prepend_timeout_events(
-              P, Debug_1, S, TimeoutEvents, [TimeoutEvent])
-    end;
-prepend_timeout_events(
-  P, Debug, S, [{timeout,_}|TimeoutEvents], EventsR) ->
-    %% Ignore since there are other events in queue
-    %% so they have cancelled the event timeout 0.
-    prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR);
-prepend_timeout_events(
-  P, Debug, S, [TimeoutEvent|TimeoutEvents], EventsR) ->
-    %% Just prepend all others
-    case Debug of
-        ?not_sys_debug ->
-            prepend_timeout_events(
-              P, Debug, S, TimeoutEvents, [TimeoutEvent|EventsR]);
-        _ ->
-            {State,_Data} = S#state.state_data,
-            Debug_1 =
-                sys_debug(
-                  Debug, P#params.name,
-                  {insert_timeout,TimeoutEvent,State}),
-            prepend_timeout_events(
-              P, Debug_1, S, TimeoutEvents, [TimeoutEvent|EventsR])
-    end.
-
 
 
 %%---------------------------------------------------------------------------
@@ -2380,7 +2359,7 @@ terminate(
     case Stacktrace of
 	[] ->
 	    erlang:Class(Reason);
-	_ ->
+	[_|_] ->
 	    erlang:raise(Class, Reason, Stacktrace)
     end.
 
@@ -2793,17 +2772,28 @@ listify(Item) ->
            ok
    end).
 %%
-%% Cancel timer and consume timeout message
+%% Cancel erlang: timer and consume timeout message
 %%
 -compile({inline, [cancel_timer/1]}).
 cancel_timer(TimerRef) ->
     ?cancel_timer(TimerRef).
 
+
 -define(
    cancel_timer(TimeoutType, TimerRef, Timers),
-   begin
-       ?cancel_timer(TimerRef),
-       maps:remove(begin TimeoutType end, begin Timers end)
+   case (TimerRef) of
+       0 ->
+           maps:remove(
+             begin TimeoutType end,
+             maps:update(
+               t0q,
+               lists:delete(
+                 begin TimeoutType end,
+                 maps:get(t0q, begin Timers end)),
+               begin Timers end));
+       _ ->
+           ?cancel_timer(TimerRef),
+           maps:remove(begin TimeoutType end, begin Timers end)
    end).
 %%
 %% Cancel timer and remove from Timers
@@ -2824,10 +2814,13 @@ cancel_timer(TimeoutType, Timers) ->
             Timers
     end.
 
+
 %% Return a list of all pending timeouts
 list_timeouts(Timers) ->
-    {maps:size(Timers),
+    {maps:size(Timers) - 1, % Subtract fixed key 't0q'
      maps:fold(
-       fun(TimeoutType, {_TimerRef,TimeoutMsg}, Acc) ->
+       fun (t0q, _, Acc) ->
+               Acc;
+           (TimeoutType, {_TimerRef,TimeoutMsg}, Acc) ->
                [{TimeoutType,TimeoutMsg}|Acc]
        end, [], Timers)}.
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 76dee868e9..d656dcd048 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -931,13 +931,11 @@ state_timeout(_Config) ->
 		       [{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
+		      %% a state_timeout 0 event and that
+		      %% state_timeout 0 can be restarted
 		      {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}}) ->
+		  (state_timeout, 6, {ok,4,{Time,From}}) ->
 		      {next_state, state3, 6,
 		       [{reply,From,ok},
 			{state_timeout,Time,8}]}
-- 
2.26.2

openSUSE Build Service is sponsored by