From: Arnaud Charlet Date: Thu, 12 Mar 2020 13:46:55 +0000 (-0400) Subject: [Ada] AI12-0364 Add a modular atomic arithmetic package X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=73266be246a1bf1781b8ef6ee1395e8602681350;p=gcc.git [Ada] AI12-0364 Add a modular atomic arithmetic package 2020-06-10 Arnaud Charlet gcc/ada/ * libgnat/s-aomoar.ads, libgnat/s-aomoar.adb: New files. * libgnat/s-atopar.ads: Move... * libgnat/s-aoinar.ads: Here. * libgnat/s-atopar.adb: Move... * libgnat/s-aoinar.adb: Here. * impunit.adb: Update list of runtime files. * Makefile.rtl (GNATRTL_NONTASKING_OBJS=): Adjust. --- diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index b09159e7e9a..15b8b00db57 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -505,13 +505,14 @@ GNATRTL_NONTASKING_OBJS= \ machcode$(objext) \ s-addima$(objext) \ s-addope$(objext) \ + s-aoinar$(objext) \ + s-aomoar$(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) \ diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 7561a198a36..70733563fb1 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -624,9 +624,10 @@ package body Impunit is ("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 + ("s-aoinar", T), -- System.Atomic_Operations.Integer_Arithmetic + ("s-aomoar", T), -- System.Atomic_Operations.Modular_Arithmetic ("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 ("a-stteou", T), -- Ada.Strings.Text_Output ("a-stouut", T), -- Ada.Strings.Text_Output.Utils diff --git a/gcc/ada/libgnat/s-aoinar.adb b/gcc/ada/libgnat/s-aoinar.adb new file mode 100644 index 00000000000..4cc6aa70314 --- /dev/null +++ b/gcc/ada/libgnat/s-aoinar.adb @@ -0,0 +1,148 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Integer_Arithmetic -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019-2020, 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.Integer_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 Atomic_Type'Object_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 Atomic_Type'Object_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 + pragma Unreferenced (Item); + use type Interfaces.C.size_t; + begin + return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8)); + end Is_Lock_Free; + +end System.Atomic_Operations.Integer_Arithmetic; diff --git a/gcc/ada/libgnat/s-aoinar.ads b/gcc/ada/libgnat/s-aoinar.ads new file mode 100644 index 00000000000..e76e7f116c5 --- /dev/null +++ b/gcc/ada/libgnat/s-aoinar.ads @@ -0,0 +1,69 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Integer_Arithmetic -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019-2020, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +pragma Ada_2020; + +generic + type Atomic_Type is range <> with Atomic; +package System.Atomic_Operations.Integer_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.Integer_Arithmetic; diff --git a/gcc/ada/libgnat/s-aomoar.adb b/gcc/ada/libgnat/s-aomoar.adb new file mode 100644 index 00000000000..9f350c14634 --- /dev/null +++ b/gcc/ada/libgnat/s-aomoar.adb @@ -0,0 +1,215 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Modular_Arithmetic -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019-2020, 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 System.Atomic_Operations.Exchange; +with Interfaces.C; use Interfaces; + +package body System.Atomic_Operations.Modular_Arithmetic is + + package Exchange is new System.Atomic_Operations.Exchange (Atomic_Type); + + ---------------- + -- 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 + -- Use the direct intrinsics when possible, and fallback to + -- compare-and-exchange otherwise. + -- Also suppress spurious warnings. + + pragma Warnings (Off); + if Atomic_Type'Base'Last = Atomic_Type'Last + and then Atomic_Type'First = 0 + and then Atomic_Type'Last + in 2 ** 8 - 1 | 2 ** 16 - 1 | 2 ** 32 - 1 | 2 ** 64 - 1 + then + pragma Warnings (On); + case Unsigned_64 (Atomic_Type'Last) is + when 2 ** 8 - 1 => + return Atomic_Fetch_Add_1 (Item'Address, Value); + when 2 ** 16 - 1 => + return Atomic_Fetch_Add_2 (Item'Address, Value); + when 2 ** 32 - 1 => + return Atomic_Fetch_Add_4 (Item'Address, Value); + when 2 ** 64 - 1 => + return Atomic_Fetch_Add_8 (Item'Address, Value); + when others => + raise Program_Error; + end case; + else + declare + Old_Value : aliased Atomic_Type := Item; + New_Value : Atomic_Type := Old_Value + Value; + begin + -- Keep iterating until the exchange succeeds + + while not Exchange.Atomic_Compare_And_Exchange + (Item, Old_Value, New_Value) + loop + New_Value := Old_Value + Value; + end loop; + + return Old_Value; + end; + end if; + 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 + -- Use the direct intrinsics when possible, and fallback to + -- compare-and-exchange otherwise. + -- Also suppress spurious warnings. + + pragma Warnings (Off); + if Atomic_Type'Base'Last = Atomic_Type'Last + and then Atomic_Type'First = 0 + and then Atomic_Type'Last + in 2 ** 8 - 1 | 2 ** 16 - 1 | 2 ** 32 - 1 | 2 ** 64 - 1 + then + pragma Warnings (On); + case Unsigned_64 (Atomic_Type'Last) is + when 2 ** 8 - 1 => + return Atomic_Fetch_Sub_1 (Item'Address, Value); + when 2 ** 16 - 1 => + return Atomic_Fetch_Sub_2 (Item'Address, Value); + when 2 ** 32 - 1 => + return Atomic_Fetch_Sub_4 (Item'Address, Value); + when 2 ** 64 - 1 => + return Atomic_Fetch_Sub_8 (Item'Address, Value); + when others => + raise Program_Error; + end case; + else + declare + Old_Value : aliased Atomic_Type := Item; + New_Value : Atomic_Type := Old_Value - Value; + begin + -- Keep iterating until the exchange succeeds + + while not Exchange.Atomic_Compare_And_Exchange + (Item, Old_Value, New_Value) + loop + New_Value := Old_Value - Value; + end loop; + + return Old_Value; + end; + end if; + end Atomic_Fetch_And_Subtract; + + ------------------ + -- Is_Lock_Free -- + ------------------ + + function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is + pragma Unreferenced (Item); + use type Interfaces.C.size_t; + begin + return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8)); + end Is_Lock_Free; + +end System.Atomic_Operations.Modular_Arithmetic; diff --git a/gcc/ada/libgnat/s-aomoar.ads b/gcc/ada/libgnat/s-aomoar.ads new file mode 100644 index 00000000000..c41dc617e5e --- /dev/null +++ b/gcc/ada/libgnat/s-aomoar.ads @@ -0,0 +1,69 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Modular_Arithmetic -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019-2020, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +pragma Ada_2020; + +generic + type Atomic_Type is mod <> with Atomic; +package System.Atomic_Operations.Modular_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.Modular_Arithmetic; diff --git a/gcc/ada/libgnat/s-atopar.adb b/gcc/ada/libgnat/s-atopar.adb deleted file mode 100644 index 554561c3468..00000000000 --- a/gcc/ada/libgnat/s-atopar.adb +++ /dev/null @@ -1,148 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- System.Atomic_Operations.Arithmetic -- --- -- --- B o d y -- --- -- --- Copyright (C) 2019-2020, 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 Atomic_Type'Object_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 Atomic_Type'Object_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 - pragma Unreferenced (Item); - use type Interfaces.C.size_t; - begin - return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_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 deleted file mode 100644 index 37bb2b17659..00000000000 --- a/gcc/ada/libgnat/s-atopar.ads +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- System.Atomic_Operations.Arithmetic -- --- -- --- S p e c -- --- -- --- Copyright (C) 2019-2020, Free Software Foundation, Inc. -- --- -- --- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. The copyright notice above, and the license provisions that follow -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2020; - -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;