[Ada] AI12-0234/321 atomic operations

2019-12-16  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* libgnat/s-aotase.adb, libgnat/s-aotase.ads,
	libgnat/s-atoope.ads, libgnat/s-atopar.adb,
	libgnat/s-atopar.ads, libgnat/s-atopex.adb,
	libgnat/s-atopex.ads: New files.
	* libgnat/s-atopri.ads: Add new intrinsics.
	* Makefile.rtl: Add new runtime files.
	* impunit.adb: Add new units to Ada 2020 list.

From-SVN: r279434

gcc/ada/ChangeLog

+2019-12-16  Arnaud Charlet  <charlet@adacore.com>
+
+	* libgnat/s-aotase.adb, libgnat/s-aotase.ads,
+	libgnat/s-atoope.ads, libgnat/s-atopar.adb,
+	libgnat/s-atopar.ads, libgnat/s-atopex.adb,
+	libgnat/s-atopex.ads: New files.
+	* libgnat/s-atopri.ads: Add new intrinsics.
+	* Makefile.rtl: Add new runtime files.
+	* impunit.adb: Add new units to Ada 2020 list.
+
 2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* freeze.adb (Check_Strict_Alignment): Remove new check on

gcc/ada/Makefile.rtl

@@ -498,10 +498,14 @@ GNATRTL_NONTASKING_OBJS= \
   machcode$(objext) \
   s-addima$(objext) \
   s-addope$(objext) \
+  s-aotase$(objext) \
   s-arit64$(objext) \
   s-assert$(objext) \
   s-atacco$(objext) \
   s-atocou$(objext) \
+  s-atoope$(objext) \
+  s-atopar$(objext) \
+  s-atopex$(objext) \
   s-atopri$(objext) \
   s-auxdec$(objext) \
   s-bignum$(objext) \

gcc/ada/impunit.adb

@@ -623,7 +623,11 @@ package body Impunit is
     ("a-stteou", T),  -- Ada.Strings.Text_Output
     ("a-nubinu", T),  -- Ada.Numerics.Big_Numbers
     ("a-nbnbin", T),  -- Ada.Numerics.Big_Numbers.Big_Integers
-    ("a-nbnbre", T)); -- Ada.Numerics.Big_Numbers.Big_Reals
+    ("a-nbnbre", T),  -- Ada.Numerics.Big_Numbers.Big_Reals
+    ("s-aotase", T),  -- System.Atomic_Operations.Test_And_Set
+    ("s-atoope", T),  -- System.Atomic_Operations
+    ("s-atopar", T),  -- System.Atomic_Operations.Arithmetic
+    ("s-atopex", T)); -- System.Atomic_Operations.Exchange
 
    -----------------------
    -- Alternative Units --

gcc/ada/libgnat/s-aotase.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  System.Atomic_Operations.Test_And_Set                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Atomic_Primitives; use System.Atomic_Primitives;
+
+package body System.Atomic_Operations.Test_And_Set is
+
+   -------------------------
+   -- Atomic_Test_And_Set --
+   -------------------------
+
+   function Atomic_Test_And_Set
+     (Item : aliased in out Test_And_Set_Flag) return Boolean is
+   begin
+      return Boolean (Atomic_Test_And_Set (Item'Address));
+   end Atomic_Test_And_Set;
+
+   ------------------
+   -- Atomic_Clear --
+   ------------------
+
+   procedure Atomic_Clear
+     (Item : aliased in out Test_And_Set_Flag) is
+   begin
+      Atomic_Clear (Item'Address);
+   end Atomic_Clear;
+
+   ------------------
+   -- Is_Lock_Free --
+   ------------------
+
+   function Is_Lock_Free (Item : aliased Test_And_Set_Flag) return Boolean is
+      pragma Unreferenced (Item);
+   begin
+      return True;
+   end Is_Lock_Free;
+
+end System.Atomic_Operations.Test_And_Set;

gcc/ada/libgnat/s-aotase.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  System.Atomic_Operations.Test_And_Set                   --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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 System.Atomic_Operations.Test_And_Set
+  with Pure
+--  Nonblocking
+is
+   type Test_And_Set_Flag is mod 2 ** 8
+     with Atomic, Default_Value => 0, Size => 8;
+
+   function Atomic_Test_And_Set
+     (Item : aliased in out Test_And_Set_Flag) return Boolean
+     with Convention => Intrinsic;
+
+   procedure Atomic_Clear
+     (Item : aliased in out Test_And_Set_Flag)
+     with Convention => Intrinsic;
+
+   function Is_Lock_Free
+     (Item : aliased Test_And_Set_Flag) return Boolean
+     with Convention => Intrinsic;
+
+private
+   pragma Inline_Always (Atomic_Test_And_Set);
+   pragma Inline_Always (Atomic_Clear);
+   pragma Inline_Always (Is_Lock_Free);
+end System.Atomic_Operations.Test_And_Set;

gcc/ada/libgnat/s-atoope.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--              S Y S T E M . A T O M I C _ O P E R A T I O N S             --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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 System.Atomic_Operations
+  with Pure
+is
+end System.Atomic_Operations;

gcc/ada/libgnat/s-atopar.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                   System.Atomic_Operations.Arithmetic                    --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Atomic_Primitives; use System.Atomic_Primitives;
+with Interfaces.C;
+
+package body System.Atomic_Operations.Arithmetic is
+
+   ----------------
+   -- Atomic_Add --
+   ----------------
+
+   procedure Atomic_Add
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type)
+   is
+      Ignore : constant Atomic_Type := Atomic_Fetch_And_Add (Item, Value);
+   begin
+      null;
+   end Atomic_Add;
+
+   ---------------------
+   -- Atomic_Subtract --
+   ---------------------
+
+   procedure Atomic_Subtract
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type)
+   is
+      Ignore : constant Atomic_Type := Atomic_Fetch_And_Subtract (Item, Value);
+   begin
+      null;
+   end Atomic_Subtract;
+
+   --------------------------
+   -- Atomic_Fetch_And_Add --
+   --------------------------
+
+   function Atomic_Fetch_And_Add
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type
+   is
+      pragma Warnings (Off);
+      function Atomic_Fetch_Add_1
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Add_1, "__atomic_fetch_add_1");
+      function Atomic_Fetch_Add_2
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Add_2, "__atomic_fetch_add_2");
+      function Atomic_Fetch_Add_4
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Add_4, "__atomic_fetch_add_4");
+      function Atomic_Fetch_Add_8
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Add_8, "__atomic_fetch_add_8");
+      pragma Warnings (On);
+
+   begin
+      case Item'Size is
+         when 8      => return Atomic_Fetch_Add_1 (Item'Address, Value);
+         when 16     => return Atomic_Fetch_Add_2 (Item'Address, Value);
+         when 32     => return Atomic_Fetch_Add_4 (Item'Address, Value);
+         when 64     => return Atomic_Fetch_Add_8 (Item'Address, Value);
+         when others => raise Program_Error;
+      end case;
+   end Atomic_Fetch_And_Add;
+
+   -------------------------------
+   -- Atomic_Fetch_And_Subtract --
+   -------------------------------
+
+   function Atomic_Fetch_And_Subtract
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type
+   is
+      pragma Warnings (Off);
+      function Atomic_Fetch_Sub_1
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1");
+      function Atomic_Fetch_Sub_2
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2");
+      function Atomic_Fetch_Sub_4
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4");
+      function Atomic_Fetch_Sub_8
+        (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
+        return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8");
+      pragma Warnings (On);
+
+   begin
+      case Item'Size is
+         when 8      => return Atomic_Fetch_Sub_1 (Item'Address, Value);
+         when 16     => return Atomic_Fetch_Sub_2 (Item'Address, Value);
+         when 32     => return Atomic_Fetch_Sub_4 (Item'Address, Value);
+         when 64     => return Atomic_Fetch_Sub_8 (Item'Address, Value);
+         when others => raise Program_Error;
+      end case;
+   end Atomic_Fetch_And_Subtract;
+
+   ------------------
+   -- Is_Lock_Free --
+   ------------------
+
+   function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
+      use type Interfaces.C.size_t;
+   begin
+      return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
+   end Is_Lock_Free;
+
+end System.Atomic_Operations.Arithmetic;

gcc/ada/libgnat/s-atopar.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                   System.Atomic_Operations.Arithmetic                    --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+generic
+   type Atomic_Type is range <>; -- ??? with Atomic;
+package System.Atomic_Operations.Arithmetic
+  with Pure
+--  Nonblocking
+is
+   procedure Atomic_Add
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) with Convention => Intrinsic;
+
+   procedure Atomic_Subtract
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) with Convention => Intrinsic;
+
+   function Atomic_Fetch_And_Add
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
+
+   function Atomic_Fetch_And_Subtract
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
+
+   function Is_Lock_Free
+     (Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic;
+
+private
+   pragma Inline_Always (Atomic_Add);
+   pragma Inline_Always (Atomic_Subtract);
+   pragma Inline_Always (Atomic_Fetch_And_Add);
+   pragma Inline_Always (Atomic_Fetch_And_Subtract);
+   pragma Inline_Always (Is_Lock_Free);
+end System.Atomic_Operations.Arithmetic;

gcc/ada/libgnat/s-atopex.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                    System.Atomic_Operations.Exchange                     --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Atomic_Primitives; use System.Atomic_Primitives;
+with Interfaces.C;
+
+package body System.Atomic_Operations.Exchange is
+
+   ---------------------
+   -- Atomic_Exchange --
+   ---------------------
+
+   function Atomic_Exchange
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type
+   is
+      pragma Warnings (Off);
+      function Atomic_Exchange_1
+        (Ptr   : System.Address;
+         Val   : Atomic_Type;
+         Model : Mem_Model := Seq_Cst) return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Exchange_1, "__atomic_exchange_1");
+      function Atomic_Exchange_2
+        (Ptr   : System.Address;
+         Val   : Atomic_Type;
+         Model : Mem_Model := Seq_Cst) return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Exchange_2, "__atomic_exchange_2");
+      function Atomic_Exchange_4
+        (Ptr   : System.Address;
+         Val   : Atomic_Type;
+         Model : Mem_Model := Seq_Cst) return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Exchange_4, "__atomic_exchange_4");
+      function Atomic_Exchange_8
+        (Ptr   : System.Address;
+         Val   : Atomic_Type;
+         Model : Mem_Model := Seq_Cst) return Atomic_Type;
+      pragma Import (Intrinsic, Atomic_Exchange_8, "__atomic_exchange_8");
+      pragma Warnings (On);
+
+   begin
+      case Item'Size is
+         when 8      => return Atomic_Exchange_1 (Item'Address, Value);
+         when 16     => return Atomic_Exchange_2 (Item'Address, Value);
+         when 32     => return Atomic_Exchange_4 (Item'Address, Value);
+         when 64     => return Atomic_Exchange_8 (Item'Address, Value);
+         when others => raise Program_Error;
+      end case;
+   end Atomic_Exchange;
+
+   ---------------------------------
+   -- Atomic_Compare_And_Exchange --
+   ---------------------------------
+
+   function Atomic_Compare_And_Exchange
+     (Item    : aliased in out Atomic_Type;
+      Prior   : aliased in out Atomic_Type;
+      Desired : Atomic_Type) return Boolean
+   is
+      pragma Warnings (Off);
+      function Atomic_Compare_Exchange_1
+        (Ptr           : System.Address;
+         Expected      : System.Address;
+         Desired       : Atomic_Type;
+         Weak          : bool := False;
+         Success_Model : Mem_Model := Seq_Cst;
+         Failure_Model : Mem_Model := Seq_Cst) return bool;
+      pragma Import
+        (Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1");
+      function Atomic_Compare_Exchange_2
+        (Ptr           : System.Address;
+         Expected      : System.Address;
+         Desired       : Atomic_Type;
+         Weak          : bool := False;
+         Success_Model : Mem_Model := Seq_Cst;
+         Failure_Model : Mem_Model := Seq_Cst) return bool;
+      pragma Import
+        (Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2");
+      function Atomic_Compare_Exchange_4
+        (Ptr           : System.Address;
+         Expected      : System.Address;
+         Desired       : Atomic_Type;
+         Weak          : bool := False;
+         Success_Model : Mem_Model := Seq_Cst;
+         Failure_Model : Mem_Model := Seq_Cst) return bool;
+      pragma Import
+        (Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
+      function Atomic_Compare_Exchange_8
+        (Ptr           : System.Address;
+         Expected      : System.Address;
+         Desired       : Atomic_Type;
+         Weak          : bool := False;
+         Success_Model : Mem_Model := Seq_Cst;
+         Failure_Model : Mem_Model := Seq_Cst) return bool;
+      pragma Import
+        (Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
+      pragma Warnings (On);
+
+   begin
+      case Item'Size is
+         when 8 =>
+            return Boolean
+              (Atomic_Compare_Exchange_1
+                (Item'Address, Prior'Address, Desired));
+         when 16 =>
+            return Boolean
+              (Atomic_Compare_Exchange_2
+                (Item'Address, Prior'Address, Desired));
+         when 32 =>
+            return Boolean
+              (Atomic_Compare_Exchange_4
+                (Item'Address, Prior'Address, Desired));
+         when 64 =>
+            return Boolean
+              (Atomic_Compare_Exchange_8
+                (Item'Address, Prior'Address, Desired));
+         when others =>
+            raise Program_Error;
+      end case;
+   end Atomic_Compare_And_Exchange;
+
+   ------------------
+   -- Is_Lock_Free --
+   ------------------
+
+   function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
+      use type Interfaces.C.size_t;
+   begin
+      return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
+   end Is_Lock_Free;
+
+end System.Atomic_Operations.Exchange;

gcc/ada/libgnat/s-atopex.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                    System.Atomic_Operations.Exchange                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                 Copyright (C) 2019, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+generic
+   type Atomic_Type is private;  --  with Atomic;
+package System.Atomic_Operations.Exchange
+  with Pure
+--  Blocking
+is
+   function Atomic_Exchange
+     (Item  : aliased in out Atomic_Type;
+      Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
+
+   function Atomic_Compare_And_Exchange
+     (Item    : aliased in out Atomic_Type;
+      Prior   : aliased in out Atomic_Type;
+      Desired : Atomic_Type) return Boolean with Convention => Intrinsic;
+
+   function Is_Lock_Free
+     (Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic;
+
+private
+   pragma Inline_Always (Atomic_Exchange);
+   pragma Inline_Always (Atomic_Compare_And_Exchange);
+   pragma Inline_Always (Is_Lock_Free);
+end System.Atomic_Operations.Exchange;

gcc/ada/libgnat/s-atopri.ads

@@ -33,8 +33,10 @@
 --  functions and operations used by the compiler to generate the lock-free
 --  implementation of protected objects.
 
+with Interfaces.C;
+
 package System.Atomic_Primitives is
-   pragma Preelaborate;
+   pragma Pure;
 
    type uint is mod 2 ** Long_Integer'Size;
 
@@ -60,6 +62,9 @@ package System.Atomic_Primitives is
 
    subtype Mem_Model is Integer range Relaxed .. Last;
 
+   type bool is new Boolean;
+   pragma Convention (C, bool);
+
    ------------------------------------
    -- GCC built-in atomic primitives --
    ------------------------------------
@@ -130,6 +135,22 @@ package System.Atomic_Primitives is
    --                 Atomic_Compare_Exchange_8,
    --                 "__atomic_compare_exchange_1");
 
+   function Atomic_Test_And_Set
+     (Ptr   : System.Address;
+      Model : Mem_Model := Seq_Cst) return bool;
+   pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
+
+   procedure Atomic_Clear
+     (Ptr   : System.Address;
+      Model : Mem_Model := Seq_Cst);
+   pragma Import (Intrinsic, Atomic_Clear, "__atomic_clear");
+
+   function Atomic_Always_Lock_Free
+     (Size : Interfaces.C.size_t;
+      Ptr  : System.Address := System.Null_Address) return bool;
+   pragma Import
+     (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
+
    --------------------------
    -- Lock-free operations --
    --------------------------