Mercurial > hg > CbC > CbC_gcc
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; |