ada: Enable Support_Atomic_Primitives on PPC Linux

gcc/ada/

	* libgnat/system-linux-ppc.ads: Add Support_Atomic_Primitives.
	* libgnat/s-atopri__32.ads: Add 32 bit version of s-atopri.ads.
	* Makefile.rtl: Use s-atopro__32.ads for ppc-linux.

3 files changed, 151 insertions, 0 deletions

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 96306f8cc9a..2cfdd8dc613 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -2185,6 +2185,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(target_cpu) $(target_os))),)
       EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
     endif
   else
+    LIBGNAT_TARGET_PAIRS += s-atopri.ads<libgnat/s-atopri__32.ads
     ifeq ($(strip $(MULTISUBDIR)),/64)
       LIBGNAT_TARGET_PAIRS += $(GNATRTL_128BIT_PAIRS)
       EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
diff --git a/gcc/ada/libgnat/s-atopri__32.ads b/gcc/ada/libgnat/s-atopri__32.ads
new file mode 100644
index 00000000000..1281e9bea31
--- /dev/null
+++ b/gcc/ada/libgnat/s-atopri__32.ads
@@ -0,0 +1,149 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . A T O M I C _ P R I M I T I V E S            --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--              Copyright (C) 2012-2023, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains both atomic primitives defined from GCC built-in
+--  functions and operations used by the compiler to generate the lock-free
+--  implementation of protected objects.
+--  This is the version that only contains primitives available on 32 bit
+--  platforms.
+
+with Interfaces.C;
+
+package System.Atomic_Primitives is
+   pragma Pure;
+
+   type uint is mod 2 ** Long_Integer'Size;
+
+   type uint8  is mod 2**8
+     with Size => 8;
+
+   type uint16 is mod 2**16
+     with Size => 16;
+
+   type uint32 is mod 2**32
+     with Size => 32;
+
+   Relaxed : constant := 0;
+   Consume : constant := 1;
+   Acquire : constant := 2;
+   Release : constant := 3;
+   Acq_Rel : constant := 4;
+   Seq_Cst : constant := 5;
+   Last    : constant := 6;
+
+   subtype Mem_Model is Integer range Relaxed .. Last;
+
+   ------------------------------------
+   -- GCC built-in atomic primitives --
+   ------------------------------------
+
+   generic
+      type Atomic_Type is mod <>;
+   function Atomic_Load
+     (Ptr   : Address;
+      Model : Mem_Model := Seq_Cst) return Atomic_Type;
+   pragma Import (Intrinsic, Atomic_Load, "__atomic_load_n");
+
+   function Atomic_Load_8  is new Atomic_Load (uint8);
+   function Atomic_Load_16 is new Atomic_Load (uint16);
+   function Atomic_Load_32 is new Atomic_Load (uint32);
+
+   generic
+      type Atomic_Type is mod <>;
+   function Atomic_Compare_Exchange
+     (Ptr           : Address;
+      Expected      : Address;
+      Desired       : Atomic_Type;
+      Weak          : Boolean   := False;
+      Success_Model : Mem_Model := Seq_Cst;
+      Failure_Model : Mem_Model := Seq_Cst) return Boolean;
+   pragma Import
+     (Intrinsic, Atomic_Compare_Exchange, "__atomic_compare_exchange_n");
+
+   function Atomic_Compare_Exchange_8  is new Atomic_Compare_Exchange (uint8);
+   function Atomic_Compare_Exchange_16 is new Atomic_Compare_Exchange (uint16);
+   function Atomic_Compare_Exchange_32 is new Atomic_Compare_Exchange (uint32);
+
+   function Atomic_Test_And_Set
+     (Ptr   : System.Address;
+      Model : Mem_Model := Seq_Cst) return Boolean;
+   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 Boolean;
+   pragma Import
+     (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
+
+   --------------------------
+   -- Lock-free operations --
+   --------------------------
+
+   --  The lock-free implementation uses two atomic instructions for the
+   --  expansion of protected operations:
+
+   --  * Lock_Free_Read atomically loads the value contained in Ptr (with the
+   --    Acquire synchronization mode).
+
+   --  * Lock_Free_Try_Write atomically tries to write the Desired value into
+   --    Ptr if Ptr contains the Expected value. It returns true if the value
+   --    in Ptr was changed, or False if it was not, in which case Expected is
+   --    updated to the unexpected value in Ptr. Note that it does nothing and
+   --    returns true if Desired and Expected are equal.
+
+   generic
+      type Atomic_Type is mod <>;
+   function Lock_Free_Read (Ptr : Address) return Atomic_Type;
+
+   function Lock_Free_Read_8  is new Lock_Free_Read (uint8);
+   function Lock_Free_Read_16 is new Lock_Free_Read (uint16);
+   function Lock_Free_Read_32 is new Lock_Free_Read (uint32);
+
+   generic
+      type Atomic_Type is mod <>;
+   function Lock_Free_Try_Write
+     (Ptr      : Address;
+      Expected : in out Atomic_Type;
+      Desired  : Atomic_Type) return Boolean;
+
+   function Lock_Free_Try_Write_8  is new Lock_Free_Try_Write (uint8);
+   function Lock_Free_Try_Write_16 is new Lock_Free_Try_Write (uint16);
+   function Lock_Free_Try_Write_32 is new Lock_Free_Try_Write (uint32);
+
+private
+   pragma Inline (Lock_Free_Read);
+   pragma Inline (Lock_Free_Try_Write);
+end System.Atomic_Primitives;
diff --git a/gcc/ada/libgnat/system-linux-ppc.ads b/gcc/ada/libgnat/system-linux-ppc.ads
index a24d6164da4..f5bb80187f1 100644
--- a/gcc/ada/libgnat/system-linux-ppc.ads
+++ b/gcc/ada/libgnat/system-linux-ppc.ads
@@ -142,6 +142,7 @@ private
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
    Support_Aggregates        : constant Boolean := True;
+   Support_Atomic_Primitives : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
    Support_Long_Shifts       : constant Boolean := True;