2013-02-08 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 195888 using svnmerge.py



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@195892 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 117 insertions, 54 deletions

diff --git a/gcc/ada/s-osprim-mingw.adb b/gcc/ada/s-osprim-mingw.adb
index 931d0127623..874b1cb186a 100644
--- a/gcc/ada/s-osprim-mingw.adb
+++ b/gcc/ada/s-osprim-mingw.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -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;
 
@@ -42,50 +44,53 @@ package body System.OS_Primitives is
    -- Data for the high resolution clock --
    ----------------------------------------
 
-   --  Declare some pointers to access multi-word data above. This is needed
-   --  to workaround a limitation in the GNU/Linker auto-import feature used
-   --  to build the GNAT runtime DLLs. In fact the Clock and Monotonic_Clock
-   --  routines are inlined and they are using some multi-word variables.
-   --  GNU/Linker will fail to auto-import those variables when building
-   --  libgnarl.dll. The indirection level introduced here has no measurable
-   --  penalties.
+   Tick_Frequency : aliased LARGE_INTEGER;
+   --  Holds frequency of high-performance counter used by Clock
+   --  Windows NT uses a 1_193_182 Hz counter on PCs.
 
-   type DA is access all Duration;
-   --  Use to have indirect access to multi-word variables
+   Base_Monotonic_Ticks : LARGE_INTEGER;
+   --  Holds the Tick count for the base monotonic time
 
-   type LIA is access all LARGE_INTEGER;
-   --  Use to have indirect access to multi-word variables
+   Base_Monotonic_Clock : Duration;
+   --  Holds the current clock for monotonic clock's base time
 
-   type LLIA is access all Long_Long_Integer;
-   --  Use to have indirect access to multi-word variables
+   type Clock_Data is record
+      Base_Ticks : LARGE_INTEGER;
+      --  Holds the Tick count for the base time
 
-   Tick_Frequency : aliased LARGE_INTEGER;
-   TFA : constant LIA := Tick_Frequency'Access;
-   --  Holds frequency of high-performance counter used by Clock
-   --  Windows NT uses a 1_193_182 Hz counter on PCs.
+      Base_Time : Long_Long_Integer;
+      --  Holds the base time used to check for system time change, used with
+      --  the standard clock.
 
-   Base_Ticks : aliased LARGE_INTEGER;
-   BTA : constant LIA := Base_Ticks'Access;
-   --  Holds the Tick count for the base time
+      Base_Clock : Duration;
+      --  Holds the current clock for the standard clock's base time
+   end record;
 
-   Base_Monotonic_Ticks : aliased LARGE_INTEGER;
-   BMTA : constant LIA := Base_Monotonic_Ticks'Access;
-   --  Holds the Tick count for the base monotonic time
+   type Clock_Data_Access is access all Clock_Data;
 
-   Base_Clock : aliased Duration;
-   BCA : constant DA := Base_Clock'Access;
-   --  Holds the current clock for the standard clock's base time
+   --  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.
 
-   Base_Monotonic_Clock : aliased Duration;
-   BMCA : constant DA := Base_Monotonic_Clock'Access;
-   --  Holds the current clock for monotonic clock's base time
+   First, Second : aliased Clock_Data;
+   Current       : Clock_Data_Access := First'Access;
+   pragma Atomic (Current);
 
-   Base_Time : aliased Long_Long_Integer;
-   BTiA : constant LLIA := Base_Time'Access;
-   --  Holds the base time used to check for system time change, used with
-   --  the standard clock.
+   --  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.
 
-   procedure Get_Base_Time;
+   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
@@ -105,12 +110,28 @@ package body System.OS_Primitives is
    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;
@@ -118,12 +139,12 @@ package body System.OS_Primitives is
       GetSystemTimeAsFileTime (Now'Access);
 
       Elap_Secs_Sys :=
-        Duration (Long_Long_Float (abs (Now - BTiA.all)) /
+        Duration (Long_Long_Float (abs (Now - Data.Base_Time)) /
                     Hundreds_Nano_In_Sec);
 
       Elap_Secs_Tick :=
-        Duration (Long_Long_Float (Current_Ticks - BTA.all) /
-                  Long_Long_Float (TFA.all));
+        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
       --  the Clock. This is probably due to a manual Clock adjustment, a DST
@@ -131,21 +152,21 @@ package body System.OS_Primitives is
       --  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 - BTA.all) /
-                     Long_Long_Float (TFA.all));
+           Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) /
+                     Long_Long_Float (Tick_Frequency));
       end if;
 
-      return BCA.all + 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
 
@@ -159,11 +180,13 @@ package body System.OS_Primitives is
       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
@@ -180,6 +203,28 @@ package body System.OS_Primitives is
       --  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
@@ -214,8 +259,8 @@ package body System.OS_Primitives is
          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
@@ -224,9 +269,27 @@ package body System.OS_Primitives is
          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;
 
    ---------------------
@@ -243,9 +306,9 @@ package body System.OS_Primitives is
 
       else
          Elap_Secs_Tick :=
-           Duration (Long_Long_Float (Current_Ticks - BMTA.all) /
-                       Long_Long_Float (TFA.all));
-         return BMCA.all + Elap_Secs_Tick;
+           Duration (Long_Long_Float (Current_Ticks - Base_Monotonic_Ticks) /
+                       Long_Long_Float (Tick_Frequency));
+         return Base_Monotonic_Clock + Elap_Secs_Tick;
       end if;
    end Monotonic_Clock;
 
@@ -328,14 +391,14 @@ package body System.OS_Primitives is
            "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;