From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 11 Dec 2023 20:09:45 +0000 (+0100)
Subject: ada: Add __atomic_store_n binding to System.Atomic_Primitives
X-Git-Tag: basepoints/gcc-15~3086
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4784601d726e5b70b6c4e050c77749706536ccf3;p=thirdparty%2Fgcc.git

ada: Add __atomic_store_n binding to System.Atomic_Primitives

This is modeled on the existing binding for __atomic_load_n.

gcc/ada/

	* libgnat/s-atopri.ads (Atomic_Store): New generic procedure.
	(Atomic_Store_8): New instantiated procedure.
	(Atomic_Store_16): Likewise.
	(Atomic_Store_32): Likewise.
	(Atomic_Store_64): Likewise.
	* libgnat/s-atopri__32.ads (Atomic_Store): New generic procedure.
	(Atomic_Store_8): New instantiated procedure.
	(Atomic_Store_16): Likewise.
	(Atomic_Store_32): Likewise.
	* gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Implement the
	support for __atomic_store_n and __sync_bool_compare_and_swap_n.
	* gcc-interface/gigi.h (list_second): New inline function.
---

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index c3d2de22b65f..89a374fab1a5 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -6504,6 +6504,28 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 			}
 		      break;
 
+		    case BUILT_IN_SYNC_BOOL_COMPARE_AND_SWAP_N:
+		    case BUILT_IN_ATOMIC_STORE_N:
+		      /* This is a generic builtin overloaded on its second
+			 parameter type, so do type resolution based on it.  */
+		      if (list_length (gnu_param_type_list) >= 3
+			  && type_for_atomic_builtin_p
+			       (list_second (gnu_param_type_list)))
+			gnu_builtin_decl
+			  = resolve_atomic_builtin
+			      (fncode, list_second (gnu_param_type_list));
+		      else
+			{
+			  post_error
+			    ("??cannot import type-generic 'G'C'C builtin!",
+			     gnat_subprog);
+			  post_error
+			    ("\\?use a supported second parameter type",
+			     gnat_subprog);
+			  gnu_builtin_decl = NULL_TREE;
+			}
+		      break;
+
 		    case BUILT_IN_ATOMIC_COMPARE_EXCHANGE_N:
 		      /* This is a generic builtin overloaded on its third
 			 parameter type, so do type resolution based on it.  */
@@ -6525,9 +6547,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 			}
 		      break;
 
-		    case BUILT_IN_SYNC_BOOL_COMPARE_AND_SWAP_N:
 		    case BUILT_IN_SYNC_LOCK_RELEASE_N:
-		    case BUILT_IN_ATOMIC_STORE_N:
 		      post_error
 			("??unsupported type-generic 'G'C'C builtin!",
 			 gnat_subprog);
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 63ccf311c233..2a7320f0a4b8 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -1238,6 +1238,14 @@ operand_type (tree expr)
   return TREE_TYPE (TREE_OPERAND (expr, 0));
 }
 
+/* Return the second value of a list.  */
+
+static inline tree
+list_second (tree list)
+{
+  return TREE_VALUE (TREE_CHAIN (list));
+}
+
 /* Return the third value of a list.  */
 
 static inline tree
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 8ee2e371f6fc..f742812bb227 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -78,6 +78,19 @@ package System.Atomic_Primitives is
    function Atomic_Load_32 is new Atomic_Load (uint32);
    function Atomic_Load_64 is new Atomic_Load (uint64);
 
+   generic
+      type Atomic_Type is mod <>;
+   procedure Atomic_Store
+     (Ptr   : Address;
+      Value : Atomic_Type;
+      Model : Mem_Model := Seq_Cst);
+   pragma Import (Intrinsic, Atomic_Store, "__atomic_store_n");
+
+   procedure Atomic_Store_8  is new Atomic_Store (uint8);
+   procedure Atomic_Store_16 is new Atomic_Store (uint16);
+   procedure Atomic_Store_32 is new Atomic_Store (uint32);
+   procedure Atomic_Store_64 is new Atomic_Store (uint64);
+
    generic
       type Atomic_Type is mod <>;
    function Atomic_Compare_Exchange
diff --git a/gcc/ada/libgnat/s-atopri__32.ads b/gcc/ada/libgnat/s-atopri__32.ads
index 1281e9bea319..419ca179c43c 100644
--- a/gcc/ada/libgnat/s-atopri__32.ads
+++ b/gcc/ada/libgnat/s-atopri__32.ads
@@ -76,6 +76,18 @@ package System.Atomic_Primitives is
    function Atomic_Load_16 is new Atomic_Load (uint16);
    function Atomic_Load_32 is new Atomic_Load (uint32);
 
+   generic
+      type Atomic_Type is mod <>;
+   procedure Atomic_Store
+     (Ptr   : Address;
+      Value : Atomic_Type;
+      Model : Mem_Model := Seq_Cst);
+   pragma Import (Intrinsic, Atomic_Store, "__atomic_store_n");
+
+   procedure Atomic_Store_8  is new Atomic_Store (uint8);
+   procedure Atomic_Store_16 is new Atomic_Store (uint16);
+   procedure Atomic_Store_32 is new Atomic_Store (uint32);
+
    generic
       type Atomic_Type is mod <>;
    function Atomic_Compare_Exchange