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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278 | -----------------------------------------------------------------------
-- util-events-timers -- Timer list management
-- Copyright (C) 2017, 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Util.Log.Loggers;
package body Util.Events.Timers is
use type Ada.Real_Time.Time;
Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Events.Timers");
procedure Free is
new Ada.Unchecked_Deallocation (Object => Timer_Node,
Name => Timer_Node_Access);
-- -----------------------
-- Repeat the timer.
-- -----------------------
procedure Repeat (Event : in out Timer_Ref;
In_Time : in Ada.Real_Time.Time_Span) is
Timer : constant Timer_Node_Access := Event.Value;
begin
if Timer /= null and then Timer.List /= null then
Timer.List.Add (Timer, Timer.Deadline + In_Time);
end if;
end Repeat;
-- -----------------------
-- Cancel the timer.
-- -----------------------
procedure Cancel (Event : in out Timer_Ref) is
begin
if Event.Value /= null and then Event.Value.List /= null then
Event.Value.List.all.Cancel (Event.Value);
Event.Value.List := null;
end if;
end Cancel;
-- -----------------------
-- Check if the timer is ready to be executed.
-- -----------------------
function Is_Scheduled (Event : in Timer_Ref) return Boolean is
begin
return Event.Value /= null and then Event.Value.List /= null;
end Is_Scheduled;
-- -----------------------
-- Returns the deadline time for the timer execution.
-- Returns Time'Last if the timer is not scheduled.
-- -----------------------
function Time_Of_Event (Event : in Timer_Ref) return Ada.Real_Time.Time is
begin
return (if Event.Value /= null then Event.Value.Deadline else Ada.Real_Time.Time_Last);
end Time_Of_Event;
-- -----------------------
-- Set a timer to be called at the given time.
-- -----------------------
procedure Set_Timer (List : in out Timer_List;
Handler : in Timer_Access;
Event : in out Timer_Ref'Class;
At_Time : in Ada.Real_Time.Time) is
Timer : Timer_Node_Access := Event.Value;
begin
if Timer = null then
Event.Value := new Timer_Node;
Timer := Event.Value;
end if;
Timer.Handler := Handler;
-- Cancel the timer if it is part of another timer manager.
if Timer.List /= null and then Timer.List /= List.Manager'Unchecked_Access then
Timer.List.Cancel (Timer);
end if;
-- Update the timer.
Timer.List := List.Manager'Unchecked_Access;
List.Manager.Add (Timer, At_Time);
end Set_Timer;
-- -----------------------
-- Set a timer to be called after the given time span.
-- -----------------------
procedure Set_Timer (List : in out Timer_List;
Handler : in Timer_Access;
Event : in out Timer_Ref'Class;
In_Time : in Ada.Real_Time.Time_Span) is
begin
List.Set_Timer (Handler, Event, Ada.Real_Time.Clock + In_Time);
end Set_Timer;
-- -----------------------
-- Process the timer handlers that have passed the deadline and return the next
-- deadline. The <tt>Max_Count</tt> parameter allows to limit the number of timer handlers
-- that are called by operation. The default is not limited.
-- -----------------------
procedure Process (List : in out Timer_List;
Timeout : out Ada.Real_Time.Time;
Max_Count : in Natural := Natural'Last) is
Timer : Timer_Ref;
Now : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;
begin
for Count in 1 .. Max_Count loop
List.Manager.Find_Next (Now, Timeout, Timer);
exit when Timer.Value = null;
begin
Timer.Value.Handler.Time_Handler (Timer);
exception
when E : others =>
Timer_List'Class (List).Error (Timer.Value.Handler, E);
end;
Timer.Finalize;
end loop;
end Process;
-- -----------------------
-- Procedure called when a timer handler raises an exception.
-- The default operation reports an error in the logs. This procedure can be
-- overridden to implement specific error handling.
-- -----------------------
procedure Error (List : in out Timer_List;
Handler : in Timer_Access;
E : in Ada.Exceptions.Exception_Occurrence) is
pragma Unreferenced (List, Handler);
begin
Log.Error ("Timer handler raised an exception", E, True);
end Error;
overriding
procedure Adjust (Object : in out Timer_Ref) is
begin
if Object.Value /= null then
Util.Concurrent.Counters.Increment (Object.Value.Counter);
end if;
end Adjust;
overriding
procedure Finalize (Object : in out Timer_Ref) is
Is_Zero : Boolean;
begin
if Object.Value /= null then
Util.Concurrent.Counters.Decrement (Object.Value.Counter, Is_Zero);
if Is_Zero then
Free (Object.Value);
else
Object.Value := null;
end if;
end if;
end Finalize;
protected body Timer_Manager is
procedure Remove (Timer : in Timer_Node_Access) is
begin
if List = Timer then
List := Timer.Next;
Timer.Prev := null;
if List /= null then
List.Prev := null;
end if;
elsif Timer.Prev /= null then
Timer.Prev.Next := Timer.Next;
Timer.Next.Prev := Timer.Prev;
else
return;
end if;
Timer.Next := null;
Timer.Prev := null;
Timer.List := null;
end Remove;
-- -----------------------
-- Add a timer.
-- -----------------------
procedure Add (Timer : in Timer_Node_Access;
Deadline : in Ada.Real_Time.Time) is
Current : Timer_Node_Access := List;
Prev : Timer_Node_Access;
begin
Util.Concurrent.Counters.Increment (Timer.Counter);
if Timer.List /= null then
Remove (Timer);
end if;
Timer.Deadline := Deadline;
while Current /= null loop
if Current.Deadline > Deadline then
if Prev = null then
List := Timer;
else
Prev.Next := Timer;
end if;
Timer.Next := Current;
Current.Prev := Timer;
return;
end if;
Prev := Current;
Current := Current.Next;
end loop;
if Prev = null then
List := Timer;
Timer.Prev := null;
else
Prev.Next := Timer;
Timer.Prev := Prev;
end if;
Timer.Next := null;
end Add;
-- -----------------------
-- Cancel a timer.
-- -----------------------
procedure Cancel (Timer : in out Timer_Node_Access) is
Is_Zero : Boolean;
begin
if Timer.List = null then
return;
end if;
Remove (Timer);
Util.Concurrent.Counters.Decrement (Timer.Counter, Is_Zero);
if Is_Zero then
Free (Timer);
end if;
end Cancel;
-- -----------------------
-- Find the next timer to be executed before the given time or return the next deadline.
-- -----------------------
procedure Find_Next (Before : in Ada.Real_Time.Time;
Deadline : out Ada.Real_Time.Time;
Timer : in out Timer_Ref) is
begin
if List = null then
Deadline := Ada.Real_Time.Time_Last;
elsif List.Deadline < Before then
Timer.Value := List;
List := List.Next;
if List /= null then
List.Prev := null;
Deadline := List.Deadline;
else
Deadline := Ada.Real_Time.Time_Last;
end if;
else
Deadline := List.Deadline;
end if;
end Find_Next;
end Timer_Manager;
overriding
procedure Finalize (Object : in out Timer_List) is
Timer : Timer_Ref;
Timeout : Ada.Real_Time.Time;
begin
loop
Object.Manager.Find_Next (Ada.Real_Time.Time_Last, Timeout, Timer);
exit when Timer.Value = null;
Timer.Finalize;
end loop;
end Finalize;
end Util.Events.Timers;
|