aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@adacore.com>2019-12-16 10:34:51 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-12-16 10:34:51 +0000
commit019c74bb73109510a75711c620ed8717d6a3045d (patch)
treeeb691d39c1948d8f21a3d59859db4392bbf2cef8 /gcc
parent1dcdd961c5cdce6e850ff20b1954919972553920 (diff)
downloadgcc-019c74bb73109510a75711c620ed8717d6a3045d.zip
gcc-019c74bb73109510a75711c620ed8717d6a3045d.tar.gz
gcc-019c74bb73109510a75711c620ed8717d6a3045d.tar.bz2
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/Makefile.rtl4
-rw-r--r--gcc/ada/impunit.adb6
-rw-r--r--gcc/ada/libgnat/s-aotase.adb66
-rw-r--r--gcc/ada/libgnat/s-aotase.ads55
-rw-r--r--gcc/ada/libgnat/s-atoope.ads35
-rw-r--r--gcc/ada/libgnat/s-atopar.adb147
-rw-r--r--gcc/ada/libgnat/s-atopar.ads63
-rw-r--r--gcc/ada/libgnat/s-atopex.adb159
-rw-r--r--gcc/ada/libgnat/s-atopex.ads54
-rw-r--r--gcc/ada/libgnat/s-atopri.ads23
11 files changed, 620 insertions, 2 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8f5c089..73a3ec7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+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
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index baa9d93..55ff9b0 100644
--- a/gcc/ada/Makefile.rtl
+++ b/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) \
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 99bb998..c53cdf9 100644
--- a/gcc/ada/impunit.adb
+++ b/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 --
diff --git a/gcc/ada/libgnat/s-aotase.adb b/gcc/ada/libgnat/s-aotase.adb
new file mode 100644
index 0000000..7ed6ab8
--- /dev/null
+++ b/gcc/ada/libgnat/s-aotase.adb
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-aotase.ads b/gcc/ada/libgnat/s-aotase.ads
new file mode 100644
index 0000000..0406630
--- /dev/null
+++ b/gcc/ada/libgnat/s-aotase.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atoope.ads b/gcc/ada/libgnat/s-atoope.ads
new file mode 100644
index 0000000..cbe089b
--- /dev/null
+++ b/gcc/ada/libgnat/s-atoope.ads
@@ -0,0 +1,35 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atopar.adb b/gcc/ada/libgnat/s-atopar.adb
new file mode 100644
index 0000000..82cfbd3
--- /dev/null
+++ b/gcc/ada/libgnat/s-atopar.adb
@@ -0,0 +1,147 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atopar.ads b/gcc/ada/libgnat/s-atopar.ads
new file mode 100644
index 0000000..a555dbc
--- /dev/null
+++ b/gcc/ada/libgnat/s-atopar.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb
new file mode 100644
index 0000000..624d3d5
--- /dev/null
+++ b/gcc/ada/libgnat/s-atopex.adb
@@ -0,0 +1,159 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atopex.ads b/gcc/ada/libgnat/s-atopex.ads
new file mode 100644
index 0000000..40f87a2
--- /dev/null
+++ b/gcc/ada/libgnat/s-atopex.ads
@@ -0,0 +1,54 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index c4ac47f..b65156a 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/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 --
--------------------------