]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
84481f76 RK |
4 | -- -- |
5 | -- S Y S T E M . O S _ P R I M I T I V E S -- | |
6 | -- -- | |
d90e94c7 | 7 | -- B o d y -- |
84481f76 | 8 | -- -- |
4b490c1e | 9 | -- Copyright (C) 1998-2020, Free Software Foundation, Inc. -- |
84481f76 RK |
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- -- | |
748086b7 JJ |
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- -- | |
84481f76 | 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
748086b7 JJ |
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/>. -- | |
84481f76 | 26 | -- -- |
71ff80dc | 27 | -- GNARL was developed by the GNARL team at Florida State University. -- |
fbf5a39b | 28 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- |
84481f76 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | -- This is the NT version of this package | |
33 | ||
42ae3870 | 34 | with System.Task_Lock; |
3824d9af | 35 | with System.Win32.Ext; |
84481f76 RK |
36 | |
37 | package body System.OS_Primitives is | |
38 | ||
42ae3870 | 39 | use System.Task_Lock; |
3824d9af PO |
40 | use System.Win32; |
41 | use System.Win32.Ext; | |
fbf5a39b AC |
42 | |
43 | ---------------------------------------- | |
44 | -- Data for the high resolution clock -- | |
45 | ---------------------------------------- | |
46 | ||
fbf5a39b | 47 | Tick_Frequency : aliased LARGE_INTEGER; |
84481f76 RK |
48 | -- Holds frequency of high-performance counter used by Clock |
49 | -- Windows NT uses a 1_193_182 Hz counter on PCs. | |
50 | ||
9b7424a7 | 51 | Base_Monotonic_Ticks : LARGE_INTEGER; |
91b1417d | 52 | -- Holds the Tick count for the base monotonic time |
fbf5a39b | 53 | |
9b7424a7 | 54 | Base_Monotonic_Clock : Duration; |
84481f76 RK |
55 | -- Holds the current clock for monotonic clock's base time |
56 | ||
42ae3870 AC |
57 | type Clock_Data is record |
58 | Base_Ticks : LARGE_INTEGER; | |
59 | -- Holds the Tick count for the base time | |
60 | ||
61 | Base_Time : Long_Long_Integer; | |
62 | -- Holds the base time used to check for system time change, used with | |
63 | -- the standard clock. | |
64 | ||
65 | Base_Clock : Duration; | |
66 | -- Holds the current clock for the standard clock's base time | |
67 | end record; | |
68 | ||
69 | type Clock_Data_Access is access all Clock_Data; | |
70 | ||
354c3840 AC |
71 | -- Two base clock buffers. This is used to be able to update a buffer while |
72 | -- the other buffer is read. The point is that we do not want to use a lock | |
73 | -- inside the Clock routine for performance reasons. We still use a lock | |
74 | -- in the Get_Base_Time which is called very rarely. Current is a pointer, | |
75 | -- the pragma Atomic is there to ensure that the value can be set or read | |
76 | -- atomically. That's it, when Get_Base_Time has updated a buffer the | |
77 | -- switch to the new value is done by changing Current pointer. | |
42ae3870 AC |
78 | |
79 | First, Second : aliased Clock_Data; | |
354c3840 AC |
80 | |
81 | Current : Clock_Data_Access := First'Access; | |
42ae3870 | 82 | pragma Atomic (Current); |
84481f76 | 83 | |
42ae3870 AC |
84 | -- The following signature is to detect change on the base clock data |
85 | -- above. The signature is a modular type, it will wrap around without | |
86 | -- raising an exception. We would need to have exactly 2**32 updates of | |
87 | -- the base data for the changes to get undetected. | |
88 | ||
89 | type Signature_Type is mod 2**32; | |
c2a2dbcc | 90 | Signature : Signature_Type := 0; |
42ae3870 AC |
91 | pragma Atomic (Signature); |
92 | ||
69d8d8b4 AC |
93 | function Monotonic_Clock return Duration; |
94 | pragma Export (Ada, Monotonic_Clock, "__gnat_monotonic_clock"); | |
95 | -- Return "absolute" time, represented as an offset relative to "the Unix | |
96 | -- Epoch", which is Jan 1, 1970 00:00:00 UTC. This clock implementation is | |
00c93ba2 AC |
97 | -- immune to the system's clock changes. Export this function so that it |
98 | -- can be imported from s-taprop-mingw.adb without changing the shared | |
99 | -- spec (s-osprim.ads). | |
69d8d8b4 | 100 | |
07aff4e3 | 101 | procedure Get_Base_Time (Data : in out Clock_Data); |
fbf5a39b AC |
102 | -- Retrieve the base time and base ticks. These values will be used by |
103 | -- clock to compute the current time by adding to it a fraction of the | |
c2a2dbcc RD |
104 | -- performance counter. This is for the implementation of a high-resolution |
105 | -- clock. Note that this routine does not change the base monotonic values | |
106 | -- used by the monotonic clock. | |
84481f76 RK |
107 | |
108 | ----------- | |
109 | -- Clock -- | |
110 | ----------- | |
111 | ||
112 | -- This implementation of clock provides high resolution timer values | |
113 | -- using QueryPerformanceCounter. This call return a 64 bits values (based | |
114 | -- on the 8253 16 bits counter). This counter is updated every 1/1_193_182 | |
115 | -- times per seconds. The call to QueryPerformanceCounter takes 6 | |
116 | -- microsecs to complete. | |
117 | ||
118 | function Clock return Duration is | |
fbf5a39b AC |
119 | Max_Shift : constant Duration := 2.0; |
120 | Hundreds_Nano_In_Sec : constant Long_Long_Float := 1.0E7; | |
42ae3870 | 121 | Data : Clock_Data; |
84481f76 RK |
122 | Current_Ticks : aliased LARGE_INTEGER; |
123 | Elap_Secs_Tick : Duration; | |
124 | Elap_Secs_Sys : Duration; | |
125 | Now : aliased Long_Long_Integer; | |
42ae3870 | 126 | Sig1, Sig2 : Signature_Type; |
84481f76 RK |
127 | |
128 | begin | |
42ae3870 AC |
129 | -- Try ten times to get a coherent set of base data. For this we just |
130 | -- check that the signature hasn't changed during the copy of the | |
131 | -- current data. | |
132 | -- | |
133 | -- This loop will always be done once if there is no interleaved call | |
134 | -- to Get_Base_Time. | |
135 | ||
136 | for K in 1 .. 10 loop | |
137 | Sig1 := Signature; | |
138 | Data := Current.all; | |
139 | Sig2 := Signature; | |
140 | exit when Sig1 = Sig2; | |
141 | end loop; | |
142 | ||
3824d9af | 143 | if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then |
84481f76 RK |
144 | return 0.0; |
145 | end if; | |
146 | ||
147 | GetSystemTimeAsFileTime (Now'Access); | |
148 | ||
149 | Elap_Secs_Sys := | |
42ae3870 | 150 | Duration (Long_Long_Float (abs (Now - Data.Base_Time)) / |
fbf5a39b | 151 | Hundreds_Nano_In_Sec); |
84481f76 RK |
152 | |
153 | Elap_Secs_Tick := | |
42ae3870 | 154 | Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) / |
9b7424a7 | 155 | Long_Long_Float (Tick_Frequency)); |
84481f76 | 156 | |
276e95ca | 157 | -- If we have a shift of more than Max_Shift seconds we resynchronize |
c4c768dd AC |
158 | -- the Clock. This is probably due to a manual Clock adjustment, a DST |
159 | -- adjustment or an NTP synchronisation. And we want to adjust the time | |
160 | -- for this system (non-monotonic) clock. | |
84481f76 RK |
161 | |
162 | if abs (Elap_Secs_Sys - Elap_Secs_Tick) > Max_Shift then | |
42ae3870 | 163 | Get_Base_Time (Data); |
84481f76 RK |
164 | |
165 | Elap_Secs_Tick := | |
42ae3870 | 166 | Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) / |
9b7424a7 | 167 | Long_Long_Float (Tick_Frequency)); |
84481f76 RK |
168 | end if; |
169 | ||
42ae3870 | 170 | return Data.Base_Clock + Elap_Secs_Tick; |
84481f76 RK |
171 | end Clock; |
172 | ||
173 | ------------------- | |
174 | -- Get_Base_Time -- | |
175 | ------------------- | |
176 | ||
07aff4e3 | 177 | procedure Get_Base_Time (Data : in out Clock_Data) is |
dae22b53 | 178 | |
b11e8d6f | 179 | -- The resolution for GetSystemTime is 1 millisecond |
84481f76 RK |
180 | |
181 | -- The time to get both base times should take less than 1 millisecond. | |
182 | -- Therefore, the elapsed time reported by GetSystemTime between both | |
183 | -- actions should be null. | |
184 | ||
84481f76 RK |
185 | epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; -- win32 UTC epoch |
186 | system_time_ns : constant := 100; -- 100 ns per tick | |
187 | Sec_Unit : constant := 10#1#E9; | |
354c3840 AC |
188 | |
189 | Max_Elapsed : constant LARGE_INTEGER := | |
b27dc431 PO |
190 | LARGE_INTEGER (Tick_Frequency / 100_000); |
191 | -- Look for a precision of 0.01 ms | |
354c3840 | 192 | |
42ae3870 | 193 | Sig : constant Signature_Type := Signature; |
b27dc431 PO |
194 | |
195 | Loc_Ticks, Ctrl_Ticks : aliased LARGE_INTEGER; | |
196 | Loc_Time, Ctrl_Time : aliased Long_Long_Integer; | |
197 | Elapsed : LARGE_INTEGER; | |
198 | Current_Max : LARGE_INTEGER := LARGE_INTEGER'Last; | |
42ae3870 | 199 | New_Data : Clock_Data_Access; |
85686ad9 | 200 | |
84481f76 RK |
201 | begin |
202 | -- Here we must be sure that both of these calls are done in a short | |
203 | -- amount of time. Both are base time and should in theory be taken | |
204 | -- at the very same time. | |
205 | ||
85686ad9 AC |
206 | -- The goal of the following loop is to synchronize the system time |
207 | -- with the Win32 performance counter by getting a base offset for both. | |
208 | -- Using these offsets it is then possible to compute actual time using | |
209 | -- a performance counter which has a better precision than the Win32 | |
210 | -- time API. | |
211 | ||
c4c768dd | 212 | -- Try at most 10 times to reach the best synchronisation (below 1 |
75a5a487 RD |
213 | -- millisecond) otherwise the runtime will use the best value reached |
214 | -- during the runs. | |
84481f76 | 215 | |
42ae3870 AC |
216 | Lock; |
217 | ||
218 | -- First check that the current value has not been updated. This | |
219 | -- could happen if another task has called Clock at the same time | |
220 | -- and that Max_Shift has been reached too. | |
221 | -- | |
222 | -- But if the current value has been changed just before we entered | |
223 | -- into the critical section, we can safely return as the current | |
224 | -- base data (time, clock, ticks) have already been updated. | |
225 | ||
226 | if Sig /= Signature then | |
6b66981a | 227 | Unlock; |
42ae3870 AC |
228 | return; |
229 | end if; | |
230 | ||
231 | -- Check for the unused data buffer and set New_Data to point to it | |
232 | ||
233 | if Current = First'Access then | |
234 | New_Data := Second'Access; | |
235 | else | |
236 | New_Data := First'Access; | |
237 | end if; | |
238 | ||
85686ad9 | 239 | for K in 1 .. 10 loop |
85686ad9 | 240 | if QueryPerformanceCounter (Loc_Ticks'Access) = Win32.FALSE then |
84481f76 RK |
241 | pragma Assert |
242 | (Standard.False, | |
243 | "Could not query high performance counter in Clock"); | |
244 | null; | |
245 | end if; | |
246 | ||
b27dc431 PO |
247 | GetSystemTimeAsFileTime (Ctrl_Time'Access); |
248 | ||
308e6f3a | 249 | -- Scan for clock tick, will take up to 16ms/1ms depending on PC. |
b27dc431 | 250 | -- This cannot be an infinite loop or the system hardware is badly |
308e6f3a | 251 | -- damaged. |
84481f76 | 252 | |
b27dc431 PO |
253 | loop |
254 | GetSystemTimeAsFileTime (Loc_Time'Access); | |
ebd34478 | 255 | |
b27dc431 PO |
256 | if QueryPerformanceCounter (Ctrl_Ticks'Access) = Win32.FALSE then |
257 | pragma Assert | |
258 | (Standard.False, | |
259 | "Could not query high performance counter in Clock"); | |
260 | null; | |
261 | end if; | |
ebd34478 | 262 | |
b27dc431 PO |
263 | exit when Loc_Time /= Ctrl_Time; |
264 | Loc_Ticks := Ctrl_Ticks; | |
265 | end loop; | |
266 | ||
267 | -- Check elapsed Performance Counter between samples | |
268 | -- to choose the best one. | |
269 | ||
270 | Elapsed := Ctrl_Ticks - Loc_Ticks; | |
85686ad9 AC |
271 | |
272 | if Elapsed < Current_Max then | |
42ae3870 AC |
273 | New_Data.Base_Time := Loc_Time; |
274 | New_Data.Base_Ticks := Loc_Ticks; | |
85686ad9 | 275 | Current_Max := Elapsed; |
ebd34478 | 276 | |
b27dc431 | 277 | -- Exit the loop when we have reached the expected precision |
ebd34478 | 278 | |
b27dc431 | 279 | exit when Elapsed <= Max_Elapsed; |
85686ad9 | 280 | end if; |
84481f76 RK |
281 | end loop; |
282 | ||
354c3840 AC |
283 | New_Data.Base_Clock := |
284 | Duration | |
285 | (Long_Long_Float | |
286 | ((New_Data.Base_Time - epoch_1970) * system_time_ns) / | |
287 | Long_Long_Float (Sec_Unit)); | |
42ae3870 AC |
288 | |
289 | -- At this point all the base values have been set into the new data | |
354c3840 | 290 | -- record. Change the pointer (atomic operation) to these new values. |
42ae3870 AC |
291 | |
292 | Current := New_Data; | |
293 | Data := New_Data.all; | |
294 | ||
295 | -- Set new signature for this data set | |
296 | ||
297 | Signature := Signature + 1; | |
298 | ||
299 | Unlock; | |
300 | ||
301 | exception | |
302 | when others => | |
303 | Unlock; | |
304 | raise; | |
84481f76 RK |
305 | end Get_Base_Time; |
306 | ||
307 | --------------------- | |
308 | -- Monotonic_Clock -- | |
309 | --------------------- | |
310 | ||
311 | function Monotonic_Clock return Duration is | |
312 | Current_Ticks : aliased LARGE_INTEGER; | |
313 | Elap_Secs_Tick : Duration; | |
5277d0b7 | 314 | |
84481f76 | 315 | begin |
3824d9af | 316 | if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then |
84481f76 | 317 | return 0.0; |
5277d0b7 | 318 | |
75a5a487 RD |
319 | else |
320 | Elap_Secs_Tick := | |
9b7424a7 AC |
321 | Duration (Long_Long_Float (Current_Ticks - Base_Monotonic_Ticks) / |
322 | Long_Long_Float (Tick_Frequency)); | |
323 | return Base_Monotonic_Clock + Elap_Secs_Tick; | |
84481f76 | 324 | end if; |
84481f76 RK |
325 | end Monotonic_Clock; |
326 | ||
327 | ----------------- | |
328 | -- Timed_Delay -- | |
329 | ----------------- | |
330 | ||
331 | procedure Timed_Delay (Time : Duration; Mode : Integer) is | |
d90e94c7 JM |
332 | function Mode_Clock return Duration; |
333 | pragma Inline (Mode_Clock); | |
334 | -- Return the current clock value using either the monotonic clock or | |
335 | -- standard clock depending on the Mode value. | |
336 | ||
337 | ---------------- | |
338 | -- Mode_Clock -- | |
339 | ---------------- | |
340 | ||
341 | function Mode_Clock return Duration is | |
342 | begin | |
343 | case Mode is | |
d8f43ee6 HK |
344 | when Absolute_RT => return Monotonic_Clock; |
345 | when others => return Clock; | |
d90e94c7 JM |
346 | end case; |
347 | end Mode_Clock; | |
348 | ||
dae22b53 AC |
349 | -- Local Variables |
350 | ||
351 | Base_Time : constant Duration := Mode_Clock; | |
352 | -- Base_Time is used to detect clock set backward, in this case we | |
353 | -- cannot ensure the delay accuracy. | |
354 | ||
84481f76 RK |
355 | Rel_Time : Duration; |
356 | Abs_Time : Duration; | |
dae22b53 AC |
357 | Check_Time : Duration := Base_Time; |
358 | ||
359 | -- Start of processing for Timed Delay | |
84481f76 RK |
360 | |
361 | begin | |
362 | if Mode = Relative then | |
363 | Rel_Time := Time; | |
364 | Abs_Time := Time + Check_Time; | |
365 | else | |
366 | Rel_Time := Time - Check_Time; | |
367 | Abs_Time := Time; | |
368 | end if; | |
369 | ||
370 | if Rel_Time > 0.0 then | |
371 | loop | |
372 | Sleep (DWORD (Rel_Time * 1000.0)); | |
d90e94c7 | 373 | Check_Time := Mode_Clock; |
84481f76 | 374 | |
dae22b53 | 375 | exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; |
84481f76 RK |
376 | |
377 | Rel_Time := Abs_Time - Check_Time; | |
378 | end loop; | |
379 | end if; | |
380 | end Timed_Delay; | |
381 | ||
3b91d88e AC |
382 | ---------------- |
383 | -- Initialize -- | |
384 | ---------------- | |
84481f76 | 385 | |
3b91d88e | 386 | Initialized : Boolean := False; |
84481f76 | 387 | |
3b91d88e AC |
388 | procedure Initialize is |
389 | begin | |
390 | if Initialized then | |
391 | return; | |
392 | end if; | |
393 | ||
394 | Initialized := True; | |
395 | ||
396 | -- Get starting time as base | |
397 | ||
3824d9af PO |
398 | if QueryPerformanceFrequency (Tick_Frequency'Access) = Win32.FALSE then |
399 | raise Program_Error with | |
400 | "cannot get high performance counter frequency"; | |
3b91d88e AC |
401 | end if; |
402 | ||
42ae3870 | 403 | Get_Base_Time (Current.all); |
3b91d88e AC |
404 | |
405 | -- Keep base clock and ticks for the monotonic clock. These values | |
406 | -- should never be changed to ensure proper behavior of the monotonic | |
407 | -- clock. | |
84481f76 | 408 | |
42ae3870 AC |
409 | Base_Monotonic_Clock := Current.Base_Clock; |
410 | Base_Monotonic_Ticks := Current.Base_Ticks; | |
3b91d88e | 411 | end Initialize; |
fbf5a39b | 412 | |
84481f76 | 413 | end System.OS_Primitives; |