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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157 | with Ada.Task_Identification;
with Rx.Debug; use Rx.Debug;
package body Rx.Dispatchers.Single is
-------------
-- Is_Idle --
-------------
function Is_Idle (This : in out Dispatcher) return Boolean is (This.Idle);
--------------
-- Schedule --
--------------
overriding procedure Schedule
(Where : in out Dispatcher;
What : Runnable'Class;
Time : Ada.Calendar.Time := Ada.Calendar.Clock)
is
begin
Where.Queue.Enqueue (What, Time);
-- This must succeed sooner than later
end Schedule;
------------
-- Queuer --
------------
task body Queuer is
use Ada.Calendar;
use Ada.Task_Identification;
function Addr return String is ("@" & Image (Current_Task) & " ");
function Min (L, R : Time) return Time is (if L < R
then L
else R);
use Runnable_Holders;
Queue : Event_Queues.Set;
Seq : Event_Id := 1;
Await : Boolean := False;
begin
loop
begin
-- Block when idle, task already running, or forced shutdown
if Await or else Queue.Is_Empty or else Dispatchers.Terminating then
Debug.Trace ("queuer [terminable] (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
select
accept Enqueue (R : Runnable'Class; Time : Ada.Calendar.Time) do
Queue.Insert ((Seq, Time, +R));
end Enqueue;
Parent.Length := Natural (Queue.Length);
Debug.Trace ("queuer [enqueue]:" & Seq'Img & " (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
Seq := Seq + 1;
or
accept Reap;
Await := False;
Debug.Trace ("queuer [reaped] (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
or
terminate;
end select;
end if;
-- If idle and pending tasks, try to run one
if not Await and then not Queue.Is_Empty and then not Dispatchers.Terminating then
declare
Ev : constant Event := Queue.First_Element;
begin
Queue.Delete_First;
if Ev.Time <= Clock then
-- Try execution
select
Parent.Thread.Run (Ev.Code);
Await := True;
Parent.Length := Natural (Queue.Length);
Debug.Trace ("queuer [dequeued] delta:" & Duration'Image (Ev.Time - Clock) & " id:"
& Ev.Id'Img & " (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
else
Queue.Insert (Ev); -- Requeue failed run
Debug.Trace ("queuer [busy] ev" & Ev.Id'Img);
end select;
else
Debug.Trace ("queuer [future] delta:" & Duration'Image (Ev.Time - Clock) & " id:"
& Ev.Id'Img & " (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
Queue.Insert (Ev); -- Requeue future event
end if;
-- Block when idle but event incoming
if not Await then -- Otherwise we just ran the event!
Debug.Trace ("queuer [pending] delta:" & Duration'Image (Ev.Time - Clock)
& " (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
select
accept Enqueue (R : Runnable'Class; Time : Ada.Calendar.Time) do
Queue.Insert ((Seq, Time, +R));
end Enqueue;
Parent.Length := Natural (Queue.Length);
Debug.Trace ("queuer [enqueue]:" & Seq'Img & " (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
Seq := Seq + 1;
or
delay until Min (Ev.Time, Clock + 1.0);
Debug.Trace ("queuer [break delta:" & Duration'Image (Ev.Time - Clock)
& "] (" & Queue.Length'Img & ") " & Addr & Parent.Addr_Img);
-- Periodically break to check for global termination
-- Note that when we are past deadline this task will be
-- 100% busy
end select;
end if;
end;
end if;
exception
when E : others =>
Debug.Report (E, "Dispatchers.Single.Queuer: ", Debug.Warn, Reraise => False);
end;
end loop;
end Queuer;
------------
-- Runner --
------------
task body Runner is
use Ada.Task_Identification;
function Addr return String is ("@" & Image (Current_Task) & " ");
begin
loop
declare
RW : Runnable_Def;
begin
Debug.Trace ("runner [ready] " & Addr & Parent.Addr_Img);
Parent.Idle := True;
select
accept Run (R : Runnable_Def) do
Parent.Idle := False;
RW := R;
end Run;
or
terminate;
end select;
Debug.Trace ("runner [running] " & Addr & Parent.Addr_Img);
begin
RW.Ref.Run;
exception
when E : others =>
Debug.Report (E, "Dispatchers.Single.Runner.Run: ", Debug.Warn);
end;
Parent.Queue.Reap;
exception
when E : others =>
Debug.Report (E, "Dispatchers.Single.Runner: ", Debug.Warn, Reraise => False);
end;
end loop;
end Runner;
end Rx.Dispatchers.Single;
|