From: Arnaud Charlet Date: Mon, 16 Dec 2019 10:34:51 +0000 (+0000) Subject: [Ada] AI12-0234/321 atomic operations X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=019c74bb73109510a75711c620ed8717d6a3045d;p=gcc.git [Ada] AI12-0234/321 atomic operations 2019-12-16 Arnaud Charlet 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8f5c089bf87..73a3ec79454 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-12-16 Arnaud Charlet + + * 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 * freeze.adb (Check_Strict_Alignment): Remove new check on diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index baa9d933c2c..55ff9b0f3d5 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 99bb9980370..c53cdf986a8 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 00000000000..7ed6ab89c9f --- /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 -- +-- . -- +-- -- +-- 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 00000000000..0406630f7ad --- /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 -- +-- . -- +-- -- +-- 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 00000000000..cbe089b2c79 --- /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 -- +-- . -- +-- -- +-- 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 00000000000..82cfbd3b49b --- /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 -- +-- . -- +-- -- +-- 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 00000000000..a555dbc5b44 --- /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 -- +-- . -- +-- -- +-- 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 00000000000..624d3d5083b --- /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 -- +-- . -- +-- -- +-- 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 00000000000..40f87a218c4 --- /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 -- +-- . -- +-- -- +-- 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 c4ac47f9086..b65156a9d4f 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 -- --------------------------