[COMMITTED] ada: Add __atomic_store_n binding to System.Atomic_Primitives
Checks
Commit Message
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(-)
@@ -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);
@@ -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
@@ -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
@@ -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