Patchwork [Ada] Make sure the Clock is thread safe

login
register
mail settings
Submitter Arnaud Charlet
Date Feb. 6, 2013, 11:20 a.m.
Message ID <20130206112053.GA17814@adacore.com>
Download mbox | patch
Permalink /patch/218555/
State New
Headers show

Comments

Arnaud Charlet - Feb. 6, 2013, 11:20 a.m.
Use a simple lock when updating the base values (ticks, time, clock).

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-02-06  Pascal Obry  <obry@adacore.com>

	* s-osprim-mingw.adb (Clock): Make sure we copy all data locally
	to avoid interleaved modifications that could happen from another
	task calling Get_Base_Data.
	(Get_Base_Data): Make it a critical section. Avoid updating if another
	task has already done it.

Patch

Index: s-osprim-mingw.adb
===================================================================
--- s-osprim-mingw.adb	(revision 195798)
+++ s-osprim-mingw.adb	(working copy)
@@ -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;