1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the Monotonic version of this package for Posix and Linux targets.
34 separate (System
.Task_Primitives
.Operations
)
35 package body Monotonic
is
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
41 procedure Compute_Deadline
43 Mode
: ST
.Delay_Modes
;
44 Check_Time
: out Duration;
45 Abs_Time
: out Duration);
46 -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
47 -- Time and Mode, compute the current clock reading (Check_Time), and the
48 -- target absolute and relative clock readings (Abs_Time). The
49 -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
50 -- is always that of CLOCK_RT_Ada.
56 function Monotonic_Clock
return Duration is
57 TS
: aliased timespec
;
58 Result
: Interfaces
.C
.int
;
60 Result
:= clock_gettime
61 (clock_id
=> OSC
.CLOCK_RT_Ada
, tp
=> TS
'Unchecked_Access);
62 pragma Assert
(Result
= 0);
64 return To_Duration
(TS
);
71 function RT_Resolution
return Duration is
72 TS
: aliased timespec
;
73 Result
: Interfaces
.C
.int
;
76 Result
:= clock_getres
(OSC
.CLOCK_REALTIME
, TS
'Unchecked_Access);
77 pragma Assert
(Result
= 0);
79 return To_Duration
(TS
);
82 ----------------------
83 -- Compute_Deadline --
84 ----------------------
86 procedure Compute_Deadline
88 Mode
: ST
.Delay_Modes
;
89 Check_Time
: out Duration;
90 Abs_Time
: out Duration)
93 Check_Time
:= Monotonic_Clock
;
97 if Mode
= Relative
then
98 Abs_Time
:= Duration'Min (Time
, Max_Sensible_Delay
) + Check_Time
;
100 pragma Warnings
(Off
);
101 -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
104 -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
106 elsif Mode
= Absolute_RT
107 or else OSC
.CLOCK_RT_Ada
= OSC
.CLOCK_REALTIME
109 pragma Warnings
(On
);
110 Abs_Time
:= Duration'Min (Check_Time
+ Max_Sensible_Delay
, Time
);
112 -- Absolute deadline specified using the calendar clock, in the
113 -- case where it is not the same as the tasking clock: compensate for
114 -- difference between clock epochs (Base_Time - Base_Cal_Time).
118 Cal_Check_Time
: constant Duration := OS_Primitives
.Clock
;
119 RT_Time
: constant Duration :=
120 Time
+ Check_Time
- Cal_Check_Time
;
124 Duration'Min (Check_Time
+ Max_Sensible_Delay
, RT_Time
);
128 end Compute_Deadline
;
134 -- This is for use within the run-time system, so abort is
135 -- assumed to be already deferred, and the caller should be
136 -- holding its own ATCB lock.
138 procedure Timed_Sleep
139 (Self_ID
: ST
.Task_Id
;
141 Mode
: ST
.Delay_Modes
;
142 Reason
: System
.Tasking
.Task_States
;
143 Timedout
: out Boolean;
144 Yielded
: out Boolean)
146 pragma Unreferenced
(Reason
);
148 Base_Time
: Duration;
149 Check_Time
: Duration;
151 P_Abs_Time
: Duration;
153 Request
: aliased timespec
;
154 Result
: Interfaces
.C
.int
;
155 Exit_Outer
: Boolean := False;
164 Check_Time
=> Check_Time
,
165 Abs_Time
=> Abs_Time
);
166 Base_Time
:= Check_Time
;
168 -- To keep a sensible Max_Sensible_Delay on a target whose system
169 -- maximum is less than sensible, we split the delay into manageable
170 -- chunks of time less than or equal to the Max_System_Delay.
172 if Abs_Time
> Check_Time
then
176 pragma Warnings
(Off
, "condition is always *");
177 if Max_System_Delay
< Max_Sensible_Delay
and then
178 Abs_Time
> Check_Time
+ Max_System_Delay
180 P_Abs_Time
:= Check_Time
+ Max_System_Delay
;
182 P_Abs_Time
:= Abs_Time
;
185 pragma Warnings
(On
);
187 Request
:= To_Timespec
(P_Abs_Time
);
191 when Self_ID
.Pending_ATC_Level
< Self_ID
.ATC_Nesting_Level
;
194 pthread_cond_timedwait
195 (cond
=> Self_ID
.Common
.LL
.CV
'Access,
196 mutex
=> Self_ID
.Common
.LL
.L
'Access,
197 abstime
=> Request
'Access);
201 -- Somebody may have called Wakeup for us
206 exit Outer
when Exit_Outer
;
207 Check_Time
:= Monotonic_Clock
;
211 pragma Assert
(Standard
.False);
216 when Abs_Time
<= Check_Time
or else Check_Time
< Base_Time
;
227 -- This is for use in implementing delay statements, so we assume the
228 -- caller is abort-deferred but is holding no locks.
230 procedure Timed_Delay
231 (Self_ID
: ST
.Task_Id
;
233 Mode
: ST
.Delay_Modes
)
235 Base_Time
: Duration;
236 Check_Time
: Duration;
238 P_Abs_Time
: Duration;
239 Request
: aliased timespec
;
241 Result
: Interfaces
.C
.int
;
242 Exit_Outer
: Boolean := False;
245 Write_Lock
(Self_ID
);
250 Check_Time
=> Check_Time
,
251 Abs_Time
=> Abs_Time
);
252 Base_Time
:= Check_Time
;
254 -- To keep a sensible Max_Sensible_Delay on a target whose system
255 -- maximum is less than sensible, we split the delay into manageable
256 -- chunks of time less than or equal to the Max_System_Delay.
258 if Abs_Time
> Check_Time
then
259 Self_ID
.Common
.State
:= Delay_Sleep
;
263 pragma Warnings
(Off
, "condition is always *");
264 if Max_System_Delay
< Max_Sensible_Delay
and then
265 Abs_Time
> Check_Time
+ Max_System_Delay
267 P_Abs_Time
:= Check_Time
+ Max_System_Delay
;
269 P_Abs_Time
:= Abs_Time
;
272 pragma Warnings
(On
);
274 Request
:= To_Timespec
(P_Abs_Time
);
278 when Self_ID
.Pending_ATC_Level
< Self_ID
.ATC_Nesting_Level
;
281 pthread_cond_timedwait
282 (cond
=> Self_ID
.Common
.LL
.CV
'Access,
283 mutex
=> Self_ID
.Common
.LL
.L
'Access,
284 abstime
=> Request
'Access);
288 exit Outer
when Exit_Outer
;
289 Check_Time
:= Monotonic_Clock
;
292 when 0 | EINTR
=> null;
295 pragma Assert
(Standard
.False);
300 when Abs_Time
<= Check_Time
or else Check_Time
< Base_Time
;
305 Self_ID
.Common
.State
:= Runnable
;
309 pragma Unreferenced
(Result
);
310 Result
:= sched_yield
;