[multiple changes]

2012-07-12  Robert Dewar  <dewar@adacore.com>

	* sem_disp.adb: Minor reformatting
	* s-bytswa.ads: Minor comment update.

2012-07-12  Vincent Pucci  <pucci@adacore.com>

	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
	Atomic_Load_N replaced by Lock_Free_Read_N. Atomic_Compare_Exchange_N
	replaced by Lock_Free_Try_Write_N.
	Renaming of several local variables. For
	procedure, Expected_Comp declaration moved to the declaration
	list of the procedure.
	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64,
	RE_Atomic_Synchronize, RE_Relaxed removed.  RE_Lock_Free_Read_8,
	RE_Lock_Free_Read_16, RE_Lock_Free_Read_32, RE_Lock_Free_Read_64,
	RE_Lock_Free_Try_Write_8, RE_Lock_Free_Try_Write_16,
	RE_Lock_Free_Try_Write_32, RE_Lock_Free_Try_Write_64 added.
	* s-atopri.adb: New file.
	* s-atopri.ads (Atomic_Compare_Exchange_8): Renaming of
	parameters.  Import primitive __sync_val_compare_and_swap_1.
	(Atomic_Compare_Exchange_16): Renaming of parameters.
	Import primitive __sync_val_compare_and_swap_2.
	(Atomic_Compare_Exchange_32): Renaming of parameters.
	Import primitive __sync_val_compare_and_swap_4.
	(Atomic_Compare_Exchange_64): Renaming of parameters.  Import
	primitive __sync_val_compare_and_swap_8.
	(Atomic_Load_8): Ptr renames parameter X.
	(Atomic_Load_16): Ptr renames parameter X.
	(Atomic_Load_32): Ptr renames parameter X.
	(Atomic_Load_64): Ptr renames parameter X.
	(Lock_Free_Read_8): New routine.
	(Lock_Free_Read_16): New routine.
	(Lock_Free_Read_32): New routine.
	(Lock_Free_Read_64): New routine.
	(Lock_Free_Try_Write_8): New routine.
	(Lock_Free_Try_Write_16): New routine.
	(Lock_Free_Try_Write_32): New routine.
	(Lock_Free_Try_Write_64): New routine.

From-SVN: r189437

gcc/ada/ChangeLog

 2012-07-12  Robert Dewar  <dewar@adacore.com>
 
+	* sem_disp.adb: Minor reformatting
+	* s-bytswa.ads: Minor comment update.
+
+2012-07-12  Vincent Pucci  <pucci@adacore.com>
+
+	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
+	Atomic_Load_N replaced by Lock_Free_Read_N. Atomic_Compare_Exchange_N
+	replaced by Lock_Free_Try_Write_N.
+	Renaming of several local variables. For
+	procedure, Expected_Comp declaration moved to the declaration
+	list of the procedure.
+	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
+	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
+	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
+	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64,
+	RE_Atomic_Synchronize, RE_Relaxed removed.  RE_Lock_Free_Read_8,
+	RE_Lock_Free_Read_16, RE_Lock_Free_Read_32, RE_Lock_Free_Read_64,
+	RE_Lock_Free_Try_Write_8, RE_Lock_Free_Try_Write_16,
+	RE_Lock_Free_Try_Write_32, RE_Lock_Free_Try_Write_64 added.
+	* s-atopri.adb: New file.
+	* s-atopri.ads (Atomic_Compare_Exchange_8): Renaming of
+	parameters.  Import primitive __sync_val_compare_and_swap_1.
+	(Atomic_Compare_Exchange_16): Renaming of parameters.
+	Import primitive __sync_val_compare_and_swap_2.
+	(Atomic_Compare_Exchange_32): Renaming of parameters.
+	Import primitive __sync_val_compare_and_swap_4.
+	(Atomic_Compare_Exchange_64): Renaming of parameters.  Import
+	primitive __sync_val_compare_and_swap_8.
+	(Atomic_Load_8): Ptr renames parameter X.
+	(Atomic_Load_16): Ptr renames parameter X.
+	(Atomic_Load_32): Ptr renames parameter X.
+	(Atomic_Load_64): Ptr renames parameter X.
+	(Lock_Free_Read_8): New routine.
+	(Lock_Free_Read_16): New routine.
+	(Lock_Free_Read_32): New routine.
+	(Lock_Free_Read_64): New routine.
+	(Lock_Free_Try_Write_8): New routine.
+	(Lock_Free_Try_Write_16): New routine.
+	(Lock_Free_Try_Write_32): New routine.
+	(Lock_Free_Try_Write_64): New routine.
+
+2012-07-12  Robert Dewar  <dewar@adacore.com>
+
 	* exp_attr.adb, exp_ch9.adb, sem_ch9.adb, exp_aggr.adb: Minor
 	reformatting.
 

gcc/ada/rtsfind.ads

@@ -731,16 +731,14 @@ package Rtsfind is
      RE_Assert_Failure,                  -- System.Assertions
      RE_Raise_Assert_Failure,            -- System.Assertions
 
-     RE_Atomic_Compare_Exchange_8,       -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_16,      -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_32,      -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_64,      -- System.Atomic_Primitives
-     RE_Atomic_Load_8,                   -- System.Atomic_Primitives
-     RE_Atomic_Load_16,                  -- System.Atomic_Primitives
-     RE_Atomic_Load_32,                  -- System.Atomic_Primitives
-     RE_Atomic_Load_64,                  -- System.Atomic_Primitives
-     RE_Atomic_Synchronize,              -- System.Atomic_Primitives
-     RE_Relaxed,                         -- System.Atomic_Primitives
+     RE_Lock_Free_Read_8,                -- System.Atomic_Primitives
+     RE_Lock_Free_Read_16,               -- System.Atomic_Primitives
+     RE_Lock_Free_Read_32,               -- System.Atomic_Primitives
+     RE_Lock_Free_Read_64,               -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_8,           -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_16,          -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_32,          -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_64,          -- System.Atomic_Primitives
      RE_Uint8,                           -- System.Atomic_Primitives
      RE_Uint16,                          -- System.Atomic_Primitives
      RE_Uint32,                          -- System.Atomic_Primitives
@@ -1955,16 +1953,14 @@ package Rtsfind is
      RE_Assert_Failure                   => System_Assertions,
      RE_Raise_Assert_Failure             => System_Assertions,
 
-     RE_Atomic_Compare_Exchange_8        => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_16       => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_32       => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_64       => System_Atomic_Primitives,
-     RE_Atomic_Load_8                    => System_Atomic_Primitives,
-     RE_Atomic_Load_16                   => System_Atomic_Primitives,
-     RE_Atomic_Load_32                   => System_Atomic_Primitives,
-     RE_Atomic_Load_64                   => System_Atomic_Primitives,
-     RE_Atomic_Synchronize               => System_Atomic_Primitives,
-     RE_Relaxed                          => System_Atomic_Primitives,
+     RE_Lock_Free_Read_8                 => System_Atomic_Primitives,
+     RE_Lock_Free_Read_16                => System_Atomic_Primitives,
+     RE_Lock_Free_Read_32                => System_Atomic_Primitives,
+     RE_Lock_Free_Read_64                => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_8            => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_16           => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_32           => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_64           => System_Atomic_Primitives,
      RE_Uint8                            => System_Atomic_Primitives,
      RE_Uint16                           => System_Atomic_Primitives,
      RE_Uint32                           => System_Atomic_Primitives,

gcc/ada/s-atopri.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . A T O M I C _ P R I M I T I V E S            --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--              Copyright (C) 2012, Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Atomic_Primitives is
+   ---------------------------
+   -- Lock_Free_Try_Write_8 --
+   ---------------------------
+
+   function Lock_Free_Try_Write_8
+      (Ptr       : Address;
+       Expected  : in out uint8;
+       Desired   : uint8) return Boolean
+   is
+      Actual : uint8;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_8 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_8;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_16 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_16
+      (Ptr       : Address;
+       Expected  : in out uint16;
+       Desired   : uint16) return Boolean
+   is
+      Actual : uint16;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_16 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_16;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_32 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_32
+      (Ptr       : Address;
+       Expected  : in out uint32;
+       Desired   : uint32) return Boolean
+   is
+      Actual : uint32;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_32 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_32;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_64 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_64
+      (Ptr       : Address;
+       Expected  : in out uint64;
+       Desired   : uint64) return Boolean
+   is
+      Actual : uint64;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_64 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_64;
+end System.Atomic_Primitives;

gcc/ada/s-atopri.ads

@@ -29,10 +29,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package contains atomic primitives defined from gcc built-in functions
-
---  For now, these operations are only used by the compiler to generate the
---  lock-free implementation of protected objects.
+--  This package contains both atomic primitives defined from gcc built-in
+--  functions and operations used by the compiler to generate the lock-free
+--  implementation of protected objects.
 
 package System.Atomic_Primitives is
    pragma Preelaborate;
@@ -59,19 +58,24 @@ package System.Atomic_Primitives is
 
    subtype Mem_Model is Integer range Relaxed .. Last;
 
+   ------------------------------------
+   -- GCC built-in atomic primitives --
+   ------------------------------------
+
    function Atomic_Compare_Exchange_8
-     (X             : Address;
-      X_Old         : uint8;
-      X_Copy        : uint8) return Boolean;
+     (Ptr      : Address;
+      Expected : uint8;
+      Desired  : uint8) return uint8;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_8,
-                  "__sync_bool_compare_and_swap_1");
+                  "__sync_val_compare_and_swap_1");
 
    --  ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
    --  function Atomic_Compare_Exchange_8
-   --    (X             : Address;
-   --     X_Old         : Address;
-   --     X_Copy        : uint8;
+   --    (Ptr           : Address;
+   --     Expected      : Address;
+   --     Desired       : uint8;
+   --     Weak          : Boolean   := False;
    --     Success_Model : Mem_Model := Seq_Cst;
    --     Failure_Model : Mem_Model := Seq_Cst) return Boolean;
    --  pragma Import (Intrinsic,
@@ -79,49 +83,100 @@ package System.Atomic_Primitives is
    --                 "__atomic_compare_exchange_1");
 
    function Atomic_Compare_Exchange_16
-     (X             : Address;
-      X_Old         : uint16;
-      X_Copy        : uint16) return Boolean;
+     (Ptr      : Address;
+      Expected : uint16;
+      Desired  : uint16) return uint16;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_16,
-                  "__sync_bool_compare_and_swap_2");
+                  "__sync_val_compare_and_swap_2");
 
    function Atomic_Compare_Exchange_32
-     (X             : Address;
-      X_Old         : uint32;
-      X_Copy        : uint32) return Boolean;
+     (Ptr      : Address;
+      Expected : uint32;
+      Desired  : uint32) return uint32;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_32,
-                  "__sync_bool_compare_and_swap_4");
+                  "__sync_val_compare_and_swap_4");
 
    function Atomic_Compare_Exchange_64
-     (X             : Address;
-      X_Old         : uint64;
-      X_Copy        : uint64) return Boolean;
+     (Ptr      : Address;
+      Expected : uint64;
+      Desired  : uint64) return uint64;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_64,
-                  "__sync_bool_compare_and_swap_8");
+                  "__sync_val_compare_and_swap_8");
 
    function Atomic_Load_8
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint8;
    pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
 
    function Atomic_Load_16
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint16;
    pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
 
    function Atomic_Load_32
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint32;
    pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
 
    function Atomic_Load_64
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint64;
    pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
 
-   procedure Atomic_Synchronize;
-   pragma Import (Intrinsic, Atomic_Synchronize, "__sync_synchronize");
+   --------------------------
+   -- Lock-free operations --
+   --------------------------
+
+   --  The lock-free implementation uses two atomic instructions for the
+   --  expansion of protected operations:
+
+   --  * Lock_Free_Read_N atomically loads the value of the protected component
+   --    accessed by the current protected operation.
+
+   --  * Lock_Free_Try_Write_N tries to write the the Desired value into Ptr
+   --    only if Expected and Desired mismatch.
+
+   function Lock_Free_Read_8 (Ptr : Address) return uint8 is
+     (Atomic_Load_8 (Ptr, Acquire));
+
+   function Lock_Free_Read_16 (Ptr : Address) return uint16 is
+      (Atomic_Load_16 (Ptr, Acquire));
+
+   function Lock_Free_Read_32 (Ptr : Address) return uint32 is
+      (Atomic_Load_32 (Ptr, Acquire));
+
+   function Lock_Free_Read_64 (Ptr : Address) return uint64 is
+      (Atomic_Load_64 (Ptr, Acquire));
+
+   function Lock_Free_Try_Write_8
+      (Ptr       : Address;
+       Expected  : in out uint8;
+       Desired   : uint8) return Boolean;
+
+   function Lock_Free_Try_Write_16
+      (Ptr       : Address;
+       Expected  : in out uint16;
+       Desired   : uint16) return Boolean;
+
+   function Lock_Free_Try_Write_32
+      (Ptr       : Address;
+       Expected  : in out uint32;
+       Desired   : uint32) return Boolean;
+
+   function Lock_Free_Try_Write_64
+      (Ptr       : Address;
+       Expected  : in out uint64;
+       Desired   : uint64) return Boolean;
+
+   pragma Inline (Lock_Free_Read_8);
+   pragma Inline (Lock_Free_Read_16);
+   pragma Inline (Lock_Free_Read_32);
+   pragma Inline (Lock_Free_Read_64);
+   pragma Inline (Lock_Free_Try_Write_8);
+   pragma Inline (Lock_Free_Try_Write_16);
+   pragma Inline (Lock_Free_Try_Write_32);
+   pragma Inline (Lock_Free_Try_Write_64);
 end System.Atomic_Primitives;

gcc/ada/s-bytswa.ads

@@ -29,8 +29,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Supporting routines for GNAT.Byte_Swapping, also used directly by
---  expended code.
+--  Intrinsic routines for byte swapping. These are used by the expanded code
+--  (supporting alternative byte ordering), and by the GNAT.Byte_Swapping run
+--  time package which provides user level routines for byte swapping.
 
 package System.Byte_Swapping is