1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 10-- -- 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. -- 17-- -- 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. -- 21-- -- 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/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is the Monotonic version of this package for Posix and Linux targets. 33 34separate (System.Task_Primitives.Operations) 35package body Monotonic is 36 37 ----------------------- 38 -- Local Subprograms -- 39 ----------------------- 40 41 procedure Compute_Deadline 42 (Time : Duration; 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. 51 52 --------------------- 53 -- Monotonic_Clock -- 54 --------------------- 55 56 function Monotonic_Clock return Duration is 57 TS : aliased timespec; 58 Result : Interfaces.C.int; 59 begin 60 Result := clock_gettime 61 (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); 62 pragma Assert (Result = 0); 63 64 return To_Duration (TS); 65 end Monotonic_Clock; 66 67 ------------------- 68 -- RT_Resolution -- 69 ------------------- 70 71 function RT_Resolution return Duration is 72 TS : aliased timespec; 73 Result : Interfaces.C.int; 74 75 begin 76 Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); 77 pragma Assert (Result = 0); 78 79 return To_Duration (TS); 80 end RT_Resolution; 81 82 ---------------------- 83 -- Compute_Deadline -- 84 ---------------------- 85 86 procedure Compute_Deadline 87 (Time : Duration; 88 Mode : ST.Delay_Modes; 89 Check_Time : out Duration; 90 Abs_Time : out Duration) 91 is 92 begin 93 Check_Time := Monotonic_Clock; 94 95 -- Relative deadline 96 97 if Mode = Relative then 98 Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; 99 100 pragma Warnings (Off); 101 -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile 102 -- time known. 103 104 -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada) 105 106 elsif Mode = Absolute_RT 107 or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME 108 then 109 pragma Warnings (On); 110 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); 111 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). 115 116 else 117 declare 118 Cal_Check_Time : constant Duration := OS_Primitives.Clock; 119 RT_Time : constant Duration := 120 Time + Check_Time - Cal_Check_Time; 121 122 begin 123 Abs_Time := 124 Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time); 125 126 end; 127 end if; 128 end Compute_Deadline; 129 130 ----------------- 131 -- Timed_Sleep -- 132 ----------------- 133 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. 137 138 procedure Timed_Sleep 139 (Self_ID : ST.Task_Id; 140 Time : Duration; 141 Mode : ST.Delay_Modes; 142 Reason : System.Tasking.Task_States; 143 Timedout : out Boolean; 144 Yielded : out Boolean) 145 is 146 pragma Unreferenced (Reason); 147 148 Base_Time : Duration; 149 Check_Time : Duration; 150 Abs_Time : Duration; 151 P_Abs_Time : Duration; 152 153 Request : aliased timespec; 154 Result : Interfaces.C.int; 155 Exit_Outer : Boolean := False; 156 157 begin 158 Timedout := True; 159 Yielded := False; 160 161 Compute_Deadline 162 (Time => Time, 163 Mode => Mode, 164 Check_Time => Check_Time, 165 Abs_Time => Abs_Time); 166 Base_Time := Check_Time; 167 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. 171 172 if Abs_Time > Check_Time then 173 174 Outer : loop 175 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 179 then 180 P_Abs_Time := Check_Time + Max_System_Delay; 181 else 182 P_Abs_Time := Abs_Time; 183 Exit_Outer := True; 184 end if; 185 pragma Warnings (On); 186 187 Request := To_Timespec (P_Abs_Time); 188 189 Inner : loop 190 exit Outer 191 when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; 192 193 Result := 194 pthread_cond_timedwait 195 (cond => Self_ID.Common.LL.CV'Access, 196 mutex => (if Single_Lock 197 then Single_RTS_Lock'Access 198 else Self_ID.Common.LL.L'Access), 199 abstime => Request'Access); 200 201 case Result is 202 when 0 | EINTR => 203 -- Somebody may have called Wakeup for us 204 Timedout := False; 205 exit Outer; 206 207 when ETIMEDOUT => 208 exit Outer when Exit_Outer; 209 Check_Time := Monotonic_Clock; 210 exit Inner; 211 212 when others => 213 pragma Assert (False); 214 215 end case; 216 217 exit Outer 218 when Abs_Time <= Check_Time or else Check_Time < Base_Time; 219 220 end loop Inner; 221 end loop Outer; 222 end if; 223 end Timed_Sleep; 224 225 ----------------- 226 -- Timed_Delay -- 227 ----------------- 228 229 -- This is for use in implementing delay statements, so we assume the 230 -- caller is abort-deferred but is holding no locks. 231 232 procedure Timed_Delay 233 (Self_ID : ST.Task_Id; 234 Time : Duration; 235 Mode : ST.Delay_Modes) 236 is 237 Base_Time : Duration; 238 Check_Time : Duration; 239 Abs_Time : Duration; 240 P_Abs_Time : Duration; 241 Request : aliased timespec; 242 243 Result : Interfaces.C.int; 244 Exit_Outer : Boolean := False; 245 246 begin 247 if Single_Lock then 248 Lock_RTS; 249 end if; 250 251 Write_Lock (Self_ID); 252 253 Compute_Deadline 254 (Time => Time, 255 Mode => Mode, 256 Check_Time => Check_Time, 257 Abs_Time => Abs_Time); 258 Base_Time := Check_Time; 259 260 -- To keep a sensible Max_Sensible_Delay on a target whose system 261 -- maximum is less than sensible, we split the delay into manageable 262 -- chunks of time less than or equal to the Max_System_Delay. 263 264 if Abs_Time > Check_Time then 265 Self_ID.Common.State := Delay_Sleep; 266 267 Outer : loop 268 269 pragma Warnings (Off, "condition is always *"); 270 if Max_System_Delay < Max_Sensible_Delay and then 271 Abs_Time > Check_Time + Max_System_Delay 272 then 273 P_Abs_Time := Check_Time + Max_System_Delay; 274 else 275 P_Abs_Time := Abs_Time; 276 Exit_Outer := True; 277 end if; 278 pragma Warnings (On); 279 280 Request := To_Timespec (P_Abs_Time); 281 282 Inner : loop 283 exit Outer 284 when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; 285 286 Result := 287 pthread_cond_timedwait 288 (cond => Self_ID.Common.LL.CV'Access, 289 mutex => (if Single_Lock 290 then Single_RTS_Lock'Access 291 else Self_ID.Common.LL.L'Access), 292 abstime => Request'Access); 293 294 case Result is 295 when ETIMEDOUT => 296 exit Outer when Exit_Outer; 297 Check_Time := Monotonic_Clock; 298 exit Inner; 299 300 when 0 | EINTR => null; 301 302 when others => 303 pragma Assert (False); 304 305 end case; 306 307 exit Outer 308 when Abs_Time <= Check_Time or else Check_Time < Base_Time; 309 310 end loop Inner; 311 end loop Outer; 312 313 Self_ID.Common.State := Runnable; 314 end if; 315 316 Unlock (Self_ID); 317 318 if Single_Lock then 319 Unlock_RTS; 320 end if; 321 322 pragma Unreferenced (Result); 323 Result := sched_yield; 324 end Timed_Delay; 325 326end Monotonic; 327