rxada_0.1.0_6ff779c7/src/priv/rx-dispatchers-single.ads

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
private with Ada.Containers.Ordered_Multisets;
private with Rx.Tools.Holders;

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);

   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);

   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_Holders.Definite;
   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);

   task type Runner (Parent : access Dispatcher) is
      entry Notify; -- Tell the runner there are events to run, or a new more recent one
   end Runner;

   protected type Safe (Parent : access Dispatcher) is
      procedure Enqueue (R : Runnable'Class; Time : Ada.Calendar.Time; Notify : out Boolean);
      --  Add a runnable to be run at a certain time

      procedure Enqueue (E : Event);
      --  For internal use

      procedure Dequeue (E : out Event; Exists : out Boolean);
      --  Dequeue next event, if it exists

      procedure Set_Idle (Idle : Boolean);

      function Is_Idle return Boolean;

   private
      Queue : Event_Queues.Set;
      Seq   : Event_Id := 0;
      Idle  : Boolean  := True;
   end Safe;

   type Dispatcher is limited new Dispatchers.Dispatcher with record
      Thread  : Runner (Dispatcher'Access);
      Queue   : Safe (Dispatcher'Access);
   end record;

   function Is_Idle (This : in out Dispatcher) return Boolean is (This.Queue.Is_Idle);

end Rx.Dispatchers.Single;