diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/Makefile.rtl | 3 | ||||
| -rw-r--r-- | gcc/ada/impunit.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-aoinar.adb (renamed from gcc/ada/libgnat/s-atopar.adb) | 6 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-aoinar.ads (renamed from gcc/ada/libgnat/s-atopar.ads) | 6 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-aomoar.adb | 215 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-aomoar.ads | 69 |
6 files changed, 294 insertions, 8 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index b09159e..15b8b00 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 7561a19..7073356 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-atopar.adb b/gcc/ada/libgnat/s-aoinar.adb index 554561c..4cc6aa7 100644 --- a/gcc/ada/libgnat/s-atopar.adb +++ b/gcc/ada/libgnat/s-aoinar.adb @@ -2,7 +2,7 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- System.Atomic_Operations.Arithmetic -- +-- System.Atomic_Operations.Integer_Arithmetic -- -- -- -- B o d y -- -- -- @@ -32,7 +32,7 @@ with System.Atomic_Primitives; use System.Atomic_Primitives; with Interfaces.C; -package body System.Atomic_Operations.Arithmetic is +package body System.Atomic_Operations.Integer_Arithmetic is ---------------- -- Atomic_Add -- @@ -145,4 +145,4 @@ package body System.Atomic_Operations.Arithmetic is return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8)); end Is_Lock_Free; -end System.Atomic_Operations.Arithmetic; +end System.Atomic_Operations.Integer_Arithmetic; diff --git a/gcc/ada/libgnat/s-atopar.ads b/gcc/ada/libgnat/s-aoinar.ads index 37bb2b1..e76e7f1 100644 --- a/gcc/ada/libgnat/s-atopar.ads +++ b/gcc/ada/libgnat/s-aoinar.ads @@ -2,7 +2,7 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- System.Atomic_Operations.Arithmetic -- +-- System.Atomic_Operations.Integer_Arithmetic -- -- -- -- S p e c -- -- -- @@ -37,7 +37,7 @@ pragma Ada_2020; generic type Atomic_Type is range <> with Atomic; -package System.Atomic_Operations.Arithmetic +package System.Atomic_Operations.Integer_Arithmetic with Pure -- Nonblocking is @@ -66,4 +66,4 @@ private 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; +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 0000000..9f350c1 --- /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 -- +-- <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 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 0000000..c41dc61 --- /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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +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; |