private with Ada.Containers.Ordered_Multisets;
private with Rx.Tools.Holders;
private with System.Address_Image;
package Rx.Dispatchers.Single is
pragma Elaborate_Body;
type Dispatcher is limited new Dispatchers.Dispatcher with private;
type Ptr is access Dispatcher;
-- Schedule a code to be run at a certain point from now, in a certain Dispatcher (thread)
overriding
procedure Schedule (Where : in out Dispatcher;
What : Runnable'Class;
Time : Ada.Calendar.Time := Ada.Calendar.Clock);
not overriding
function Is_Idle (This : in out Dispatcher) return Boolean;
-- True if it is not running (but may have queued jobs for the future)
private
-- This type is composed by a queue of events to run and a task that gets the first one and runs it.
-- To Allow Termination, There'S A Notification System Between The Queue and The task.
-- The Queue is Wrapped in A protected type.
use Ada.Containers;
use type Ada.Calendar.Time;
type Dispatcher_Access is access all Dispatcher;
package Runnable_Holders is new Rx.Tools.Holders (Runnable'Class, "single.runnable'class");
subtype Runnable_Def is Runnable_Holders.Definite;
type Event_Id is new Long_Long_Integer;
type Event is record -- Needed To Hold It in The Ordered_Multiset
Id : Event_Id; -- Used to break time ties
Time : Ada.Calendar.Time;
Code : Runnable_Def;
end record;
function "<" (L, R : Event) return Boolean is
(L.Time < R.Time or else (L.Time = R.Time and then L.Id < R.Id));
package Event_Queues is new Ordered_Multisets (Event);
-- To avoid any remaining possibility of race condition, and simultaneously
-- allow automatic termination, we use a double-thread solution.
-- It is heavier on the number of threads, but has all the desired
-- advantages.
-- The Queuer (or frontend) task is always accepting new events. While it
-- has pending events, it tries continuously to pass one of these to the
-- Runner (or backend) task, which is the one effectively taking care of
-- the job.
-- Thus, no block can happen since a Runner can always call its own Queuer
task type Queuer (Parent : access Dispatcher) is
entry Enqueue (R : Runnable'Class; Time : Ada.Calendar.Time);
entry Reap; -- Used by Runner to notify runnable completion
end Queuer;
task type Runner (Parent : access Dispatcher) is
entry Run (R : Runnable_Def);
end Runner;
function Addr_Img (This : in out Dispatcher) return String is
("#" & System.Address_Image (This'Address));
type Dispatcher is limited new Dispatchers.Dispatcher with record
Idle : aliased Boolean := True with Atomic;
Length : aliased Natural := 0 with Atomic;
Queue : Queuer (Dispatcher'Access);
Thread : Runner (Dispatcher'Access);
end record;
end Rx.Dispatchers.Single;