]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Add __atomic_store_n binding to System.Atomic_Primitives
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 11 Dec 2023 20:09:45 +0000 (21:09 +0100)
committerMarc Poulhiès <poulhies@adacore.com>
Tue, 9 Jan 2024 13:13:31 +0000 (14:13 +0100)
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.

gcc/ada/gcc-interface/decl.cc
gcc/ada/gcc-interface/gigi.h
gcc/ada/libgnat/s-atopri.ads
gcc/ada/libgnat/s-atopri__32.ads

index c3d2de22b65f63271cbdc3b1bd23f3aeb58e9c05..89a374fab1a50e2908fa99f72481996ad95d0fd5 100644 (file)
@@ -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);
index 63ccf311c233974db6ad39513cf1989c7597c283..2a7320f0a4b8871d9ae293ece17f98a9cffd9fb8 100644 (file)
@@ -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
index 8ee2e371f6fca78dca13c82e3ba2e7b951d7eeeb..f742812bb227f82bdf0111ae95829e8b98d49ebc 100644 (file)
@@ -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
index 1281e9bea319eb6e9c5bdf68037176bf107a123b..419ca179c43c0d778d963ea0f60c9c9cbc8d43f2 100644 (file)
@@ -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