From: Eric Botcazou <ebotca...@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 --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
-- 
2.43.0

Reply via email to