diff mbox series

[COMMITTED] ada: Add __atomic_store_n binding to System.Atomic_Primitives

Message ID 20240109131547.744502-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Add __atomic_store_n binding to System.Atomic_Primitives | expand

Commit Message

Marc Poulhiès Jan. 9, 2024, 1:15 p.m. UTC 
From: Eric Botcazou <ebotcazou@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/decl.cc    | 24 ++++++++++++++++++++++--
 gcc/ada/gcc-interface/gigi.h     |  8 ++++++++
 gcc/ada/libgnat/s-atopri.ads     | 13 +++++++++++++
 gcc/ada/libgnat/s-atopri__32.ads | 12 ++++++++++++
 4 files changed, 55 insertions(+), 2 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index c3d2de22b65..89a374fab1a 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 63ccf311c23..2a7320f0a4b 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 8ee2e371f6f..f742812bb22 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 1281e9bea31..419ca179c43 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