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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140 | with Ada.Task_Identification;
with Rx.Debug; use Rx.Debug;
package body Rx.Dispatchers.Single is
--------------
-- Schedule --
--------------
overriding procedure Schedule
(Where : in out Dispatcher;
What : Runnable'Class;
Time : Ada.Calendar.Time := Ada.Calendar.Clock)
is
use Ada.Calendar;
use Ada.Task_Identification;
Must_Notify : Boolean;
begin
Where.Queue.Enqueue (What, Time, Must_Notify);
if Must_Notify and then Current_Task /= Where.Thread'Identity then
Where.Thread.Notify;
end if;
end Schedule;
------------
-- Runner --
------------
task body Runner is
begin
loop
declare
use Ada.Calendar;
use Runnable_Holders;
Exists : Boolean;
Ev : Event;
begin
Parent.Queue.Dequeue (Ev, Exists);
if Exists and not Dispatchers.Terminating then
if Ev.Time > Clock then
Parent.Queue.Set_Idle (True);
end if;
select
-- An earlier event has arrived, so requeue
accept Notify;
Parent.Queue.Enqueue (Ev);
or
delay until Ev.Time; -- This wait may perfectly well be 0
Parent.Queue.Set_Idle (False);
Ev.Code.Ref.Run;
end select;
else
Parent.Queue.Set_Idle (True);
select
accept Notify;
or
terminate;
end select;
end if;
exception
when E : others =>
Debug.Report (E, "At Dispatchers.Single.Runner: ", Debug.Warn, Reraise => False);
end;
end loop;
end Runner;
----------
-- Safe --
----------
protected body Safe is
-------------
-- Enqueue --
-------------
procedure Enqueue
(R : Runnable'Class;
Time : Ada.Calendar.Time;
Notify : out Boolean)
is
use Ada.Calendar;
use Runnable_Holders;
begin
if Queue.Is_Empty or else Queue.Constant_Reference (Queue.First).Time > Time then
Notify := True;
end if;
-- Put_Line ("enqueue:" & Seq'Img);
Queue.Insert ((Seq, Time, +R));
Seq := Seq + 1;
end Enqueue;
-------------
-- Enqueue --
-------------
procedure Enqueue (E : Event) is
begin
Queue.Insert (E);
end Enqueue;
-------------
-- Dequeue --
-------------
procedure Dequeue (E : out Event; Exists : out Boolean) is
begin
Exists := not Queue.Is_Empty;
if Exists then
E := Queue.First_Element;
Queue.Delete_First;
-- Put_Line ("dequeue:" & E.Id'Img);
end if;
end Dequeue;
--------------
-- Set_Idle --
--------------
procedure Set_Idle (Idle : Boolean) is
begin
Safe.Idle := Idle;
end Set_Idle;
-------------
-- Is_Idle --
-------------
function Is_Idle return Boolean is
begin
return Idle;
end Is_Idle;
end Safe;
end Rx.Dispatchers.Single;
|