===================================================================
@@ -31,10 +31,12 @@
-- This is the NT version of this package
+with System.Task_Lock;
with System.Win32.Ext;
package body System.OS_Primitives is
+ use System.Task_Lock;
use System.Win32;
use System.Win32.Ext;
@@ -46,23 +48,49 @@
-- Holds frequency of high-performance counter used by Clock
-- Windows NT uses a 1_193_182 Hz counter on PCs.
- Base_Ticks : LARGE_INTEGER;
- -- Holds the Tick count for the base time
-
Base_Monotonic_Ticks : LARGE_INTEGER;
-- Holds the Tick count for the base monotonic time
- Base_Clock : Duration;
- -- Holds the current clock for the standard clock's base time
-
Base_Monotonic_Clock : Duration;
-- Holds the current clock for monotonic clock's base time
- Base_Time : Long_Long_Integer;
- -- Holds the base time used to check for system time change, used with
- -- the standard clock.
+ type Clock_Data is record
+ Base_Ticks : LARGE_INTEGER;
+ -- Holds the Tick count for the base time
- procedure Get_Base_Time;
+ Base_Time : Long_Long_Integer;
+ -- Holds the base time used to check for system time change, used with
+ -- the standard clock.
+
+ Base_Clock : Duration;
+ -- Holds the current clock for the standard clock's base time
+ end record;
+
+ type Clock_Data_Access is access all Clock_Data;
+
+ -- Two base clock buffers. This is used to be able to update a buffer
+ -- while the other buffer is read. The point is that we do not want to
+ -- use a lock inside the Clock routine for performance reasons. We still
+ -- use a lock in the Get_Base_Time which is called very rarely. Current
+ -- is a pointer, the pragma Atomic is there to ensure that the value can
+ -- be set or read atomically. That's it, when Get_Base_Time has updated
+ -- a buffer the switch to the new value is done by changing Current
+ -- pointer.
+
+ First, Second : aliased Clock_Data;
+ Current : Clock_Data_Access := First'Access;
+ pragma Atomic (Current);
+
+ -- The following signature is to detect change on the base clock data
+ -- above. The signature is a modular type, it will wrap around without
+ -- raising an exception. We would need to have exactly 2**32 updates of
+ -- the base data for the changes to get undetected.
+
+ type Signature_Type is mod 2**32;
+ Signature : Signature_Type := 0;
+ pragma Atomic (Signature);
+
+ procedure Get_Base_Time (Data : out Clock_Data);
-- Retrieve the base time and base ticks. These values will be used by
-- clock to compute the current time by adding to it a fraction of the
-- performance counter. This is for the implementation of a
@@ -82,12 +110,28 @@
function Clock return Duration is
Max_Shift : constant Duration := 2.0;
Hundreds_Nano_In_Sec : constant Long_Long_Float := 1.0E7;
+ Data : Clock_Data;
Current_Ticks : aliased LARGE_INTEGER;
Elap_Secs_Tick : Duration;
Elap_Secs_Sys : Duration;
Now : aliased Long_Long_Integer;
+ Sig1, Sig2 : Signature_Type;
begin
+ -- Try ten times to get a coherent set of base data. For this we just
+ -- check that the signature hasn't changed during the copy of the
+ -- current data.
+ --
+ -- This loop will always be done once if there is no interleaved call
+ -- to Get_Base_Time.
+
+ for K in 1 .. 10 loop
+ Sig1 := Signature;
+ Data := Current.all;
+ Sig2 := Signature;
+ exit when Sig1 = Sig2;
+ end loop;
+
if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then
return 0.0;
end if;
@@ -95,11 +139,11 @@
GetSystemTimeAsFileTime (Now'Access);
Elap_Secs_Sys :=
- Duration (Long_Long_Float (abs (Now - Base_Time)) /
+ Duration (Long_Long_Float (abs (Now - Data.Base_Time)) /
Hundreds_Nano_In_Sec);
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) /
Long_Long_Float (Tick_Frequency));
-- If we have a shift of more than Max_Shift seconds we resynchronize
@@ -108,21 +152,21 @@
-- for this system (non-monotonic) clock.
if abs (Elap_Secs_Sys - Elap_Secs_Tick) > Max_Shift then
- Get_Base_Time;
+ Get_Base_Time (Data);
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) /
Long_Long_Float (Tick_Frequency));
end if;
- return Base_Clock + Elap_Secs_Tick;
+ return Data.Base_Clock + Elap_Secs_Tick;
end Clock;
-------------------
-- Get_Base_Time --
-------------------
- procedure Get_Base_Time is
+ procedure Get_Base_Time (Data : out Clock_Data) is
-- The resolution for GetSystemTime is 1 millisecond
@@ -136,11 +180,13 @@
Max_Elapsed : constant LARGE_INTEGER :=
LARGE_INTEGER (Tick_Frequency / 100_000);
-- Look for a precision of 0.01 ms
+ Sig : constant Signature_Type := Signature;
Loc_Ticks, Ctrl_Ticks : aliased LARGE_INTEGER;
Loc_Time, Ctrl_Time : aliased Long_Long_Integer;
Elapsed : LARGE_INTEGER;
Current_Max : LARGE_INTEGER := LARGE_INTEGER'Last;
+ New_Data : Clock_Data_Access;
begin
-- Here we must be sure that both of these calls are done in a short
@@ -157,6 +203,28 @@
-- millisecond) otherwise the runtime will use the best value reached
-- during the runs.
+ Lock;
+
+ -- First check that the current value has not been updated. This
+ -- could happen if another task has called Clock at the same time
+ -- and that Max_Shift has been reached too.
+ --
+ -- But if the current value has been changed just before we entered
+ -- into the critical section, we can safely return as the current
+ -- base data (time, clock, ticks) have already been updated.
+
+ if Sig /= Signature then
+ return;
+ end if;
+
+ -- Check for the unused data buffer and set New_Data to point to it
+
+ if Current = First'Access then
+ New_Data := Second'Access;
+ else
+ New_Data := First'Access;
+ end if;
+
for K in 1 .. 10 loop
if QueryPerformanceCounter (Loc_Ticks'Access) = Win32.FALSE then
pragma Assert
@@ -191,8 +259,8 @@
Elapsed := Ctrl_Ticks - Loc_Ticks;
if Elapsed < Current_Max then
- Base_Time := Loc_Time;
- Base_Ticks := Loc_Ticks;
+ New_Data.Base_Time := Loc_Time;
+ New_Data.Base_Ticks := Loc_Ticks;
Current_Max := Elapsed;
-- Exit the loop when we have reached the expected precision
@@ -201,9 +269,27 @@
end if;
end loop;
- Base_Clock := Duration
- (Long_Long_Float ((Base_Time - epoch_1970) * system_time_ns) /
- Long_Long_Float (Sec_Unit));
+ New_Data.Base_Clock := Duration
+ (Long_Long_Float ((New_Data.Base_Time - epoch_1970) * system_time_ns) /
+ Long_Long_Float (Sec_Unit));
+
+ -- At this point all the base values have been set into the new data
+ -- record. We just change the pointer (atomic operation) to this new
+ -- values.
+
+ Current := New_Data;
+ Data := New_Data.all;
+
+ -- Set new signature for this data set
+
+ Signature := Signature + 1;
+
+ Unlock;
+
+ exception
+ when others =>
+ Unlock;
+ raise;
end Get_Base_Time;
---------------------
@@ -305,14 +391,14 @@
"cannot get high performance counter frequency";
end if;
- Get_Base_Time;
+ Get_Base_Time (Current.all);
-- Keep base clock and ticks for the monotonic clock. These values
-- should never be changed to ensure proper behavior of the monotonic
-- clock.
- Base_Monotonic_Clock := Base_Clock;
- Base_Monotonic_Ticks := Base_Ticks;
+ Base_Monotonic_Clock := Current.Base_Clock;
+ Base_Monotonic_Ticks := Current.Base_Ticks;
end Initialize;
end System.OS_Primitives;