comparison gcc/ada/libgnarl/s-tpopmo.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC -- 5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNARL is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
40 40
41 procedure Compute_Deadline 41 procedure Compute_Deadline
42 (Time : Duration; 42 (Time : Duration;
43 Mode : ST.Delay_Modes; 43 Mode : ST.Delay_Modes;
44 Check_Time : out Duration; 44 Check_Time : out Duration;
45 Abs_Time : out Duration; 45 Abs_Time : out Duration);
46 Rel_Time : out Duration);
47 -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by 46 -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
48 -- Time and Mode, compute the current clock reading (Check_Time), and the 47 -- Time and Mode, compute the current clock reading (Check_Time), and the
49 -- target absolute and relative clock readings (Abs_Time, Rel_Time). The 48 -- target absolute and relative clock readings (Abs_Time). The
50 -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time 49 -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
51 -- is always that of CLOCK_RT_Ada. 50 -- is always that of CLOCK_RT_Ada.
52 51
53 --------------------- 52 ---------------------
54 -- Monotonic_Clock -- 53 -- Monotonic_Clock --
86 85
87 procedure Compute_Deadline 86 procedure Compute_Deadline
88 (Time : Duration; 87 (Time : Duration;
89 Mode : ST.Delay_Modes; 88 Mode : ST.Delay_Modes;
90 Check_Time : out Duration; 89 Check_Time : out Duration;
91 Abs_Time : out Duration; 90 Abs_Time : out Duration)
92 Rel_Time : out Duration)
93 is 91 is
94 begin 92 begin
95 Check_Time := Monotonic_Clock; 93 Check_Time := Monotonic_Clock;
96 94
97 -- Relative deadline 95 -- Relative deadline
98 96
99 if Mode = Relative then 97 if Mode = Relative then
100 Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; 98 Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
101
102 if Relative_Timed_Wait then
103 Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
104 end if;
105 99
106 pragma Warnings (Off); 100 pragma Warnings (Off);
107 -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile 101 -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
108 -- time known. 102 -- time known.
109 103
113 or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME 107 or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
114 then 108 then
115 pragma Warnings (On); 109 pragma Warnings (On);
116 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); 110 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
117 111
118 if Relative_Timed_Wait then
119 Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
120 end if;
121
122 -- Absolute deadline specified using the calendar clock, in the 112 -- Absolute deadline specified using the calendar clock, in the
123 -- case where it is not the same as the tasking clock: compensate for 113 -- case where it is not the same as the tasking clock: compensate for
124 -- difference between clock epochs (Base_Time - Base_Cal_Time). 114 -- difference between clock epochs (Base_Time - Base_Cal_Time).
125 115
126 else 116 else
131 121
132 begin 122 begin
133 Abs_Time := 123 Abs_Time :=
134 Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time); 124 Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
135 125
136 if Relative_Timed_Wait then
137 Rel_Time :=
138 Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
139 end if;
140 end; 126 end;
141 end if; 127 end if;
142 end Compute_Deadline; 128 end Compute_Deadline;
143 129
144 ----------------- 130 -----------------
160 pragma Unreferenced (Reason); 146 pragma Unreferenced (Reason);
161 147
162 Base_Time : Duration; 148 Base_Time : Duration;
163 Check_Time : Duration; 149 Check_Time : Duration;
164 Abs_Time : Duration; 150 Abs_Time : Duration;
165 Rel_Time : Duration; 151 P_Abs_Time : Duration;
166 152
167 Request : aliased timespec; 153 Request : aliased timespec;
168 Result : Interfaces.C.int; 154 Result : Interfaces.C.int;
155 Exit_Outer : Boolean := False;
169 156
170 begin 157 begin
171 Timedout := True; 158 Timedout := True;
172 Yielded := False; 159 Yielded := False;
173 160
174 Compute_Deadline 161 Compute_Deadline
175 (Time => Time, 162 (Time => Time,
176 Mode => Mode, 163 Mode => Mode,
177 Check_Time => Check_Time, 164 Check_Time => Check_Time,
178 Abs_Time => Abs_Time, 165 Abs_Time => Abs_Time);
179 Rel_Time => Rel_Time);
180 Base_Time := Check_Time; 166 Base_Time := Check_Time;
181 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
182 if Abs_Time > Check_Time then 172 if Abs_Time > Check_Time then
183 Request := 173
184 To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time); 174 Outer : loop
185 175
186 loop 176 pragma Warnings (Off, "condition is always *");
187 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; 177 if Max_System_Delay < Max_Sensible_Delay and then
188 178 Abs_Time > Check_Time + Max_System_Delay
189 Result := 179 then
190 pthread_cond_timedwait 180 P_Abs_Time := Check_Time + Max_System_Delay;
191 (cond => Self_ID.Common.LL.CV'Access, 181 else
192 mutex => (if Single_Lock 182 P_Abs_Time := Abs_Time;
193 then Single_RTS_Lock'Access 183 Exit_Outer := True;
194 else Self_ID.Common.LL.L'Access),
195 abstime => Request'Access);
196
197 Check_Time := Monotonic_Clock;
198 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
199
200 if Result in 0 | EINTR then
201
202 -- Somebody may have called Wakeup for us
203
204 Timedout := False;
205 exit;
206 end if; 184 end if;
207 185 pragma Warnings (On);
208 pragma Assert (Result = ETIMEDOUT); 186
209 end loop; 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;
210 end if; 222 end if;
211 end Timed_Sleep; 223 end Timed_Sleep;
212 224
213 ----------------- 225 -----------------
214 -- Timed_Delay -- 226 -- Timed_Delay --
223 Mode : ST.Delay_Modes) 235 Mode : ST.Delay_Modes)
224 is 236 is
225 Base_Time : Duration; 237 Base_Time : Duration;
226 Check_Time : Duration; 238 Check_Time : Duration;
227 Abs_Time : Duration; 239 Abs_Time : Duration;
228 Rel_Time : Duration; 240 P_Abs_Time : Duration;
229 Request : aliased timespec; 241 Request : aliased timespec;
230 242
231 Result : Interfaces.C.int; 243 Result : Interfaces.C.int;
232 pragma Warnings (Off, Result); 244 Exit_Outer : Boolean := False;
233 245
234 begin 246 begin
235 if Single_Lock then 247 if Single_Lock then
236 Lock_RTS; 248 Lock_RTS;
237 end if; 249 end if;
240 252
241 Compute_Deadline 253 Compute_Deadline
242 (Time => Time, 254 (Time => Time,
243 Mode => Mode, 255 Mode => Mode,
244 Check_Time => Check_Time, 256 Check_Time => Check_Time,
245 Abs_Time => Abs_Time, 257 Abs_Time => Abs_Time);
246 Rel_Time => Rel_Time);
247 Base_Time := Check_Time; 258 Base_Time := Check_Time;
248 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
249 if Abs_Time > Check_Time then 264 if Abs_Time > Check_Time then
250 Request :=
251 To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
252 Self_ID.Common.State := Delay_Sleep; 265 Self_ID.Common.State := Delay_Sleep;
253 266
254 loop 267 Outer : loop
255 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; 268
256 269 pragma Warnings (Off, "condition is always *");
257 Result := 270 if Max_System_Delay < Max_Sensible_Delay and then
258 pthread_cond_timedwait 271 Abs_Time > Check_Time + Max_System_Delay
259 (cond => Self_ID.Common.LL.CV'Access, 272 then
260 mutex => (if Single_Lock 273 P_Abs_Time := Check_Time + Max_System_Delay;
261 then Single_RTS_Lock'Access 274 else
262 else Self_ID.Common.LL.L'Access), 275 P_Abs_Time := Abs_Time;
263 abstime => Request'Access); 276 Exit_Outer := True;
264 277 end if;
265 Check_Time := Monotonic_Clock; 278 pragma Warnings (On);
266 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; 279
267 280 Request := To_Timespec (P_Abs_Time);
268 pragma Assert (Result in 0 | ETIMEDOUT | EINTR); 281
269 end loop; 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;
270 312
271 Self_ID.Common.State := Runnable; 313 Self_ID.Common.State := Runnable;
272 end if; 314 end if;
273 315
274 Unlock (Self_ID); 316 Unlock (Self_ID);
275 317
276 if Single_Lock then 318 if Single_Lock then
277 Unlock_RTS; 319 Unlock_RTS;
278 end if; 320 end if;
279 321
322 pragma Unreferenced (Result);
280 Result := sched_yield; 323 Result := sched_yield;
281 end Timed_Delay; 324 end Timed_Delay;
282 325
283 end Monotonic; 326 end Monotonic;