[Ada] Fix problematic import of type-generic GCC atomic builtin

gcc/ada/

	* gcc-interface/gigi.h (resolve_atomic_size): Declare.
	(list_third): New inline function.
	* gcc-interface/decl.c (type_for_atomic_builtin_p): New function.
	(resolve_atomic_builtin): Likewise.
	(gnat_to_gnu_subprog_type): Perform type resolution for most of
	type-generic GCC atomic builtins and give an error for the rest.
	* gcc-interface/utils2.c (resolve_atomic_size): Make public.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 2ed1f3e..639cf06 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -241,6 +241,8 @@ static void set_rm_size (Uint, tree, Entity_Id);
 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
 static unsigned int promote_object_alignment (tree, tree, Entity_Id);
 static void check_ok_for_atomic_type (tree, Entity_Id, bool);
+static bool type_for_atomic_builtin_p (tree);
+static tree resolve_atomic_builtin (enum built_in_function, tree);
 static tree create_field_decl_from (tree, tree, tree, tree, tree,
                                    vec<subst_pair>);
 static tree create_rep_part (tree, tree, tree);
@@ -6312,14 +6314,106 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
             the checker is expected to post diagnostics in this case.  */
          if (gnu_builtin_decl)
            {
-             const intrin_binding_t inb
-               = { gnat_subprog, gnu_type, TREE_TYPE (gnu_builtin_decl) };
-
-             if (!intrin_profiles_compatible_p (&inb))
-               post_error
-                 ("??profile of& doesn''t match the builtin it binds!",
-                  gnat_subprog);
-             return gnu_builtin_decl;
+             if (fndecl_built_in_p (gnu_builtin_decl, BUILT_IN_NORMAL))
+               {
+                 const enum built_in_function fncode
+                   = DECL_FUNCTION_CODE (gnu_builtin_decl);
+
+                 switch (fncode)
+                 {
+                   case BUILT_IN_SYNC_FETCH_AND_ADD_N:
+                   case BUILT_IN_SYNC_FETCH_AND_SUB_N:
+                   case BUILT_IN_SYNC_FETCH_AND_OR_N:
+                   case BUILT_IN_SYNC_FETCH_AND_AND_N:
+                   case BUILT_IN_SYNC_FETCH_AND_XOR_N:
+                   case BUILT_IN_SYNC_FETCH_AND_NAND_N:
+                   case BUILT_IN_SYNC_ADD_AND_FETCH_N:
+                   case BUILT_IN_SYNC_SUB_AND_FETCH_N:
+                   case BUILT_IN_SYNC_OR_AND_FETCH_N:
+                   case BUILT_IN_SYNC_AND_AND_FETCH_N:
+                   case BUILT_IN_SYNC_XOR_AND_FETCH_N:
+                   case BUILT_IN_SYNC_NAND_AND_FETCH_N:
+                   case BUILT_IN_SYNC_VAL_COMPARE_AND_SWAP_N:
+                   case BUILT_IN_SYNC_LOCK_TEST_AND_SET_N:
+                   case BUILT_IN_ATOMIC_EXCHANGE_N:
+                   case BUILT_IN_ATOMIC_LOAD_N:
+                   case BUILT_IN_ATOMIC_ADD_FETCH_N:
+                   case BUILT_IN_ATOMIC_SUB_FETCH_N:
+                   case BUILT_IN_ATOMIC_AND_FETCH_N:
+                   case BUILT_IN_ATOMIC_NAND_FETCH_N:
+                   case BUILT_IN_ATOMIC_XOR_FETCH_N:
+                   case BUILT_IN_ATOMIC_OR_FETCH_N:
+                   case BUILT_IN_ATOMIC_FETCH_ADD_N:
+                   case BUILT_IN_ATOMIC_FETCH_SUB_N:
+                   case BUILT_IN_ATOMIC_FETCH_AND_N:
+                   case BUILT_IN_ATOMIC_FETCH_NAND_N:
+                   case BUILT_IN_ATOMIC_FETCH_XOR_N:
+                   case BUILT_IN_ATOMIC_FETCH_OR_N:
+                     /* This is a generic builtin overloaded on its return
+                        type, so do type resolution based on it.  */
+                     if (!VOID_TYPE_P (gnu_return_type)
+                         && type_for_atomic_builtin_p (gnu_return_type))
+                       gnu_builtin_decl
+                         = resolve_atomic_builtin (fncode, gnu_return_type);
+                     else
+                       {
+                         post_error
+                           ("??cannot import type-generic 'G'C'C builtin!",
+                            gnat_subprog);
+                         post_error
+                           ("\\?use a supported result 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.  */
+                     if (list_length (gnu_param_type_list) >= 4
+                         && type_for_atomic_builtin_p
+                              (list_third (gnu_param_type_list)))
+                       gnu_builtin_decl
+                         = resolve_atomic_builtin
+                             (fncode, list_third (gnu_param_type_list));
+                     else
+                       {
+                         post_error
+                           ("??cannot import type-generic 'G'C'C builtin!",
+                            gnat_subprog);
+                         post_error
+                           ("\\?use a supported third parameter type",
+                            gnat_subprog);
+                         gnu_builtin_decl = NULL_TREE;
+                       }
+                     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);
+                     gnu_builtin_decl = NULL_TREE;
+                     break;
+
+                   default:
+                     break;
+                 }
+               }
+
+             if (gnu_builtin_decl)
+               {
+                 const intrin_binding_t inb
+                   = { gnat_subprog, gnu_type, TREE_TYPE (gnu_builtin_decl) };
+
+                 if (!intrin_profiles_compatible_p (&inb))
+                   post_error
+                     ("??profile of& doesn''t match the builtin it binds!",
+                      gnat_subprog);
+
+                 return gnu_builtin_decl;
+               }
            }
 
          /* Inability to find the builtin DECL most often indicates a genuine
@@ -6329,7 +6423,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
             on demand without risking false positives with common default sets
             of options.  */
          if (warn_shadow)
-           post_error ("'G'C'C intrinsic not found for&!??", gnat_subprog);
+           post_error ("'G'C'C builtin not found for&!??", gnat_subprog);
        }
     }
 
@@ -9512,6 +9606,33 @@ check_ok_for_atomic_type (tree type, Entity_Id gnat_entity, bool component_p)
                   gnat_error_point, gnat_entity);
 }
 
+/* Return true if TYPE is suitable for a type-generic atomic builtin.  */
+
+static bool
+type_for_atomic_builtin_p (tree type)
+{
+  const enum machine_mode mode = TYPE_MODE (type);
+  if (GET_MODE_CLASS (mode) == MODE_FLOAT)
+    return true;
+
+  scalar_int_mode imode;
+  if (is_a <scalar_int_mode> (mode, &imode) && GET_MODE_SIZE (imode) <= 16)
+    return true;
+
+  return false;
+}
+
+/* Return the GCC atomic builtin based on CODE and sized for TYPE.  */
+
+static tree
+resolve_atomic_builtin (enum built_in_function code, tree type)
+{
+  const unsigned int size = resolve_atomic_size (type);
+  code = (enum built_in_function) ((int) code + exact_log2 (size) + 1);
+
+  return builtin_decl_implicit (code);
+}
+
 /* Helper for intrin_profiles_compatible_p, to perform compatibility checks
    on the Ada/builtin argument lists for the INB binding.  */
 

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 692ef44..1b55ec5 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -1026,6 +1026,9 @@ extern Entity_Id get_debug_scope (Node_Id gnat_node, bool *is_subprogram);
    should be synchronized with Exp_Dbug.Debug_Renaming_Declaration.  */
 extern bool can_materialize_object_renaming_p (Node_Id expr);
 
+/* Return the size of TYPE, which must be a positive power of 2.  */
+extern unsigned int resolve_atomic_size (tree type);
+
 #ifdef __cplusplus
 extern "C" {
 #endif
@@ -1223,3 +1226,11 @@ operand_type (tree expr)
 {
   return TREE_TYPE (TREE_OPERAND (expr, 0));
 }
+
+/* Return the third value of a list.  */
+
+static inline tree
+list_third (tree list)
+{
+  return TREE_VALUE (TREE_CHAIN (TREE_CHAIN (list)));
+}

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index e8ed4b2..06d8203 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -663,7 +663,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
 
 /* Return the size of TYPE, which must be a positive power of 2.  */
 
-static unsigned int
+unsigned int
 resolve_atomic_size (tree type)
 {
   unsigned HOST_WIDE_INT size = tree_to_uhwi (TYPE_SIZE_UNIT (type));