Merge from trunk revision 89be17a1b231ade643f28fbe616d53377e069da8.

11 files changed, 235 insertions, 117 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ff5fc4e..70aaabf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,77 @@
+2021-09-15  Alexandre Oliva  <oliva@adacore.com>
+
+	* gcc-interface/utils.c: Include opts.h.
+	(handle_zero_call_used_regs_attribute): New.
+	(gnat_internal_attribute_table): Add zero_call_used_regs.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/101970
+	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Enum_Rep>:
+	Use an unchecked conversion instead of a regular conversion in the
+	enumeration case and remove Conversion_OK flag in the integer case.
+	<Attribute_Pos>: Remove superfluous test.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (validate_size): Do not issue an error if the
+	old size has overflowed.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity): For vector types, make
+	the representative array the debug type.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_subprog_type): Turn variable
+	into constant.  Capitalize GCC in warning message.
+	(intrin_arglists_compatible_p): Change parameter to pointer-to-const
+	Adjust warning messages.  Turn warning into error for vector types.
+	(intrin_return_compatible_p): Likewise.
+	(intrin_profiles_compatible_p): Change parameter to pointer-to-const
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* libgnat/s-atopri.ads (bool): Delete.
+	(Atomic_Test_And_Set): Replace bool with Boolean.
+	(Atomic_Always_Lock_Free): Likewise.
+	* libgnat/s-aoinar.adb (Is_Lock_Free): Adjust.
+	* libgnat/s-aomoar.adb (Is_Lock_Free): Likewise.
+	* libgnat/s-aotase.adb (Atomic_Test_And_Set): Likewise.
+	* libgnat/s-atopex.adb (Atomic_Compare_And_Exchange): Likewise.
+	* gcc-interface/decl.c: Include gimple-expr.h.
+	(intrin_types_incompatible_p): Delete.
+	(intrin_arglists_compatible_p): Call types_compatible_p.
+	(intrin_return_compatible_p): Likewise.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/utils.c (update_pointer_to): Set TYPE_CANONICAL on
+	pointer and reference types.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/101385
+	* doc/gnat_ugn/building_executable_programs_with_gnat.rst
+	(-Wall): Minor fixes.
+	(-w): Likewise.
+	(-Werror): Document that it also sets -gnatwe by default.
+	* gcc-interface/lang-specs.h (ada): Expand -gnatwe if -Werror is
+	passed and move expansion of -gnatw switches to before -gnatez.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/utils.c (can_materialize_object_renaming_p): Do not
+	call UI_Is_In_Int_Range on the result of Normalized_First_Bit.
+
+2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <is_type>: Declare new
+	constant.  Adjust error message issued by validate_size in the case
+	of by-reference types.
+	(validate_size): Always use the error strings passed by the caller.
+
 2021-09-08  liuhongt  <hongtao.liu@intel.com>
 
 	* gcc-interface/misc.c (gnat_post_options): Issue an error for
diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 07c38df..5a69967 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -4157,16 +4157,16 @@ of the pragma in the :title:`GNAT_Reference_manual`).
   This switch enables most warnings from the GCC back end.
   The code generator detects a number of warning situations that are missed
   by the GNAT front end, and this switch can be used to activate them.
-  The use of this switch also sets the default front end warning mode to
-  :switch:`-gnatwa`, that is, most front end warnings activated as well.
+  The use of this switch also sets the default front-end warning mode to
+  :switch:`-gnatwa`, that is, most front-end warnings are activated as well.
 
 
 .. index:: -w (gcc)
 
 :switch:`-w`
   Conversely, this switch suppresses warnings from the GCC back end.
-  The use of this switch also sets the default front end warning mode to
-  :switch:`-gnatws`, that is, front end warnings suppressed as well.
+  The use of this switch also sets the default front-end warning mode to
+  :switch:`-gnatws`, that is, front-end warnings are suppressed as well.
 
 
 .. index:: -Werror (gcc)
@@ -4175,6 +4175,9 @@ of the pragma in the :title:`GNAT_Reference_manual`).
   This switch causes warnings from the GCC back end to be treated as
   errors.  The warning string still appears, but the warning messages are
   counted as errors, and prevent the generation of an object file.
+  The use of this switch also sets the default front-end warning mode to
+  :switch:`-gnatwe`, that is, front-end warning messages and style check
+  messages are treated as errors as well.
 
 
 A string of warning parameters can be used in the same parameter. For example::
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index f074521..fc6b0ef 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3252,14 +3252,15 @@ package body Exp_Attr is
          --  If not constant-folded, Enum_Type'Enum_Rep (X) or X'Enum_Rep
          --  expands to
 
-         --    target-type (X)
+         --    target-type!(X)
 
-         --  This is simply a direct conversion from the enumeration type to
-         --  the target integer type, which is treated by the back end as a
-         --  normal integer conversion, treating the enumeration type as an
-         --  integer, which is exactly what we want. We set Conversion_OK to
-         --  make sure that the analyzer does not complain about what otherwise
-         --  might be an illegal conversion.
+         --  This is an unchecked conversion from the enumeration type to the
+         --  target integer type, which is treated by the back end as a normal
+         --  integer conversion, treating the enumeration type as an integer,
+         --  which is exactly what we want. Unlike for the Pos attribute, we
+         --  cannot use a regular conversion since the associated check would
+         --  involve comparing the converted bounds, i.e. would involve the use
+         --  of 'Pos instead 'Enum_Rep for these bounds.
 
          --  However the target type is universal integer in most cases, which
          --  is a very large type, so in the case of an enumeration type, we
@@ -3267,11 +3268,13 @@ package body Exp_Attr is
          --  the size information.
 
          if Is_Enumeration_Type (Ptyp) then
-            Rewrite (N, OK_Convert_To (Get_Integer_Type (Ptyp), Expr));
+            Rewrite (N, Unchecked_Convert_To (Get_Integer_Type (Ptyp), Expr));
             Convert_To_And_Rewrite (Typ, N);
 
+         --  Deal with integer types (replace by conversion)
+
          else
-            Rewrite (N, OK_Convert_To (Typ, Expr));
+            Rewrite (N, Convert_To (Typ, Expr));
          end if;
 
          Analyze_And_Resolve (N, Typ);
@@ -5420,7 +5423,7 @@ package body Exp_Attr is
 
          --  Deal with integer types (replace by conversion)
 
-         elsif Is_Integer_Type (Etyp) then
+         else
             Rewrite (N, Convert_To (Typ, Expr));
          end if;
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 5cedb74..0120b21 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -28,6 +28,7 @@
 #include "coretypes.h"
 #include "target.h"
 #include "tree.h"
+#include "gimple-expr.h"
 #include "stringpool.h"
 #include "diagnostic-core.h"
 #include "alias.h"
@@ -261,7 +262,7 @@ typedef struct {
   tree btin_fntype;       /* The GCC builtin function type node.  */
 } intrin_binding_t;
 
-static bool intrin_profiles_compatible_p (intrin_binding_t *);
+static bool intrin_profiles_compatible_p (const intrin_binding_t *);
 
 /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
    entity, return the equivalent GCC tree for that entity (a ..._DECL node)
@@ -4279,6 +4280,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
      handling alignment and possible padding.  */
   if (is_type && (!gnu_decl || this_made_decl))
     {
+      const bool is_by_ref = Is_By_Reference_Type (gnat_entity);
+
       gcc_assert (!TYPE_IS_DUMMY_P (gnu_type));
 
       /* Process the attributes, if not already done.  Note that the type is
@@ -4293,15 +4296,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	 non-constant).  */
       if (!gnu_size && kind != E_String_Literal_Subtype)
 	{
+	  const char *size_s = "size for %s too small{, minimum allowed is ^}";
+	  const char *type_s = is_by_ref ? "by-reference type &" : "&";
+
 	  if (Known_Esize (gnat_entity))
 	    gnu_size
 	      = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
-			       VAR_DECL, false, false, NULL, NULL);
+			       VAR_DECL, false, false, size_s, type_s);
 	  else
 	    gnu_size
 	      = validate_size (RM_Size (gnat_entity), gnu_type, gnat_entity,
 			       TYPE_DECL, false, Has_Size_Clause (gnat_entity),
-			       NULL, NULL);
+			       size_s, type_s);
 	}
 
       /* If a size was specified, see if we can make a new type of that size
@@ -4614,7 +4620,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	    TYPE_ALIGN_OK (gnu_type) = 1;
 
 	  /* Record whether the type is passed by reference.  */
-	  if (Is_By_Reference_Type (gnat_entity) && !VOID_TYPE_P (gnu_type))
+	  if (is_by_ref && !VOID_TYPE_P (gnu_type))
 	    TYPE_BY_REFERENCE_P (gnu_type) = 1;
 
 	  /* Record whether an alignment clause was specified.  */
@@ -4734,6 +4740,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
       else
 	gnu_decl = create_type_decl (gnu_entity_name, gnu_type, artificial_p,
 				     debug_info_p, gnat_entity);
+
+      /* For vector types, make the representative array the debug type.  */
+      if (VECTOR_TYPE_P (gnu_type))
+	{
+	  tree rep = TYPE_REPRESENTATIVE_ARRAY (gnu_type);
+	  TYPE_NAME (rep) = DECL_NAME (gnu_decl);
+	  SET_TYPE_DEBUG_TYPE (gnu_type, rep);
+	}
     }
 
   /* Otherwise, for a type reusing an existing DECL, back-annotate values.  */
@@ -6291,14 +6305,13 @@ 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)
 	    {
-	      intrin_binding_t inb
+	      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;
 	    }
 
@@ -6309,7 +6322,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 ("??gcc intrinsic not found for&!", gnat_subprog);
+	    post_error ("'G'C'C intrinsic not found for&!??", gnat_subprog);
 	}
     }
 
@@ -9178,13 +9191,12 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
   /* Issue an error either if the default size of the object isn't a constant
      or if the new size is smaller than it.  */
   if (TREE_CODE (old_size) != INTEGER_CST
-      || TREE_OVERFLOW (old_size)
-      || tree_int_cst_lt (size, old_size))
+      || (!TREE_OVERFLOW (old_size) && tree_int_cst_lt (size, old_size)))
     {
       char buf[128];
       const char *s;
 
-      if (kind == FIELD_DECL)
+      if (s1 && s2)
 	{
 	  snprintf (buf, sizeof (buf), s1, s2);
 	  s = buf;
@@ -9193,6 +9205,7 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
 	s = "component size for& too small{, minimum allowed is ^}";
       else
 	s = "size for& too small{, minimum allowed is ^}";
+
       post_error_ne_tree (s, gnat_error_node, gnat_object, old_size);
 
       return NULL_TREE;
@@ -9486,51 +9499,11 @@ check_ok_for_atomic_type (tree type, Entity_Id gnat_entity, bool component_p)
 		   gnat_error_point, gnat_entity);
 }
 
-
-/* Helper for the intrin compatibility checks family.  Evaluate whether
-   two types are definitely incompatible.  */
-
-static bool
-intrin_types_incompatible_p (tree t1, tree t2)
-{
-  enum tree_code code;
-
-  if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
-    return false;
-
-  if (TYPE_MODE (t1) != TYPE_MODE (t2))
-    return true;
-
-  if (TREE_CODE (t1) != TREE_CODE (t2))
-    return true;
-
-  code = TREE_CODE (t1);
-
-  switch (code)
-    {
-    case INTEGER_TYPE:
-    case REAL_TYPE:
-      return TYPE_PRECISION (t1) != TYPE_PRECISION (t2);
-
-    case POINTER_TYPE:
-    case REFERENCE_TYPE:
-      /* Assume designated types are ok.  We'd need to account for char * and
-	 void * variants to do better, which could rapidly get messy and isn't
-	 clearly worth the effort.  */
-      return false;
-
-    default:
-      break;
-    }
-
-  return false;
-}
-
 /* Helper for intrin_profiles_compatible_p, to perform compatibility checks
    on the Ada/builtin argument lists for the INB binding.  */
 
 static bool
-intrin_arglists_compatible_p (intrin_binding_t * inb)
+intrin_arglists_compatible_p (const intrin_binding_t *inb)
 {
   function_args_iterator ada_iter, btin_iter;
 
@@ -9555,27 +9528,32 @@ intrin_arglists_compatible_p (intrin_binding_t * inb)
 
       /* If we're done with the Ada args and not with the internal builtin
 	 args, or the other way around, complain.  */
-      if (ada_type == void_type_node
-	  && btin_type != void_type_node)
+      if (ada_type == void_type_node && btin_type != void_type_node)
 	{
-	  post_error ("??Ada arguments list too short!", inb->gnat_entity);
+	  post_error ("??Ada parameter list too short!", inb->gnat_entity);
 	  return false;
 	}
 
-      if (btin_type == void_type_node
-	  && ada_type != void_type_node)
+      if (btin_type == void_type_node && ada_type != void_type_node)
 	{
-	  post_error_ne_num ("??Ada arguments list too long ('> ^)!",
+	  post_error_ne_num ("??Ada parameter list too long ('> ^)!",
 			     inb->gnat_entity, inb->gnat_entity, argpos);
 	  return false;
 	}
 
       /* Otherwise, check that types match for the current argument.  */
-      argpos ++;
-      if (intrin_types_incompatible_p (ada_type, btin_type))
+      argpos++;
+      if (!types_compatible_p (ada_type, btin_type))
 	{
-	  post_error_ne_num ("??intrinsic binding type mismatch on argument ^!",
-			     inb->gnat_entity, inb->gnat_entity, argpos);
+	  /* For vector builtins, issue an error to avoid an ICE.  */
+	  if (VECTOR_TYPE_P (btin_type))
+	    post_error_ne_num
+	      ("intrinsic binding type mismatch on parameter ^",
+	       inb->gnat_entity, inb->gnat_entity, argpos);
+	  else
+	    post_error_ne_num
+	      ("??intrinsic binding type mismatch on parameter ^!",
+	       inb->gnat_entity, inb->gnat_entity, argpos);
 	  return false;
 	}
 
@@ -9591,22 +9569,26 @@ intrin_arglists_compatible_p (intrin_binding_t * inb)
    on the Ada/builtin return values for the INB binding.  */
 
 static bool
-intrin_return_compatible_p (intrin_binding_t * inb)
+intrin_return_compatible_p (const intrin_binding_t *inb)
 {
   tree ada_return_type = TREE_TYPE (inb->ada_fntype);
   tree btin_return_type = TREE_TYPE (inb->btin_fntype);
 
   /* Accept function imported as procedure, common and convenient.  */
-  if (VOID_TYPE_P (ada_return_type)
-      && !VOID_TYPE_P (btin_return_type))
+  if (VOID_TYPE_P (ada_return_type) && !VOID_TYPE_P (btin_return_type))
     return true;
 
   /* Check return types compatibility otherwise.  Note that this
      handles void/void as well.  */
-  if (intrin_types_incompatible_p (btin_return_type, ada_return_type))
+  if (!types_compatible_p (btin_return_type, ada_return_type))
     {
-      post_error ("??intrinsic binding type mismatch on return value!",
-		  inb->gnat_entity);
+      /* For vector builtins, issue an error to avoid an ICE.  */
+      if (VECTOR_TYPE_P (btin_return_type))
+	post_error ("intrinsic binding type mismatch on result",
+		    inb->gnat_entity);
+      else
+	post_error ("??intrinsic binding type mismatch on result",
+		    inb->gnat_entity);
       return false;
     }
 
@@ -9622,7 +9604,7 @@ intrin_return_compatible_p (intrin_binding_t * inb)
    especially when binding straight to a compiler internal.  */
 
 static bool
-intrin_profiles_compatible_p (intrin_binding_t * inb)
+intrin_profiles_compatible_p (const intrin_binding_t *inb)
 {
   /* Check compatibility on return values and argument lists, each responsible
      for posting warnings as appropriate.  Ensure use of the proper sloc for
diff --git a/gcc/ada/gcc-interface/lang-specs.h b/gcc/ada/gcc-interface/lang-specs.h
index f5a7496..d26cc8d 100644
--- a/gcc/ada/gcc-interface/lang-specs.h
+++ b/gcc/ada/gcc-interface/lang-specs.h
@@ -36,7 +36,7 @@
    "\
  %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
  %{!S:%{!c:%e-c or -S required for Ada}}\
- gnat1 %{I*} %{k8:-gnatk8} %{Wall:-gnatwa} %{w:-gnatws} %{!Q:-quiet}\
+ gnat1 %{I*} %{k8:-gnatk8} %{!Q:-quiet}\
     %{nostdinc*} %{nostdlib*}\
     %{fcompare-debug-second:-gnatd_A} \
     %{O*} %{W*} %{w} %{p} %{pg:-p} " ADA_DUMPS_OPTIONS " \
@@ -44,8 +44,9 @@
 #if defined(TARGET_VXWORKS_RTP)
    "%{fRTS=rtp|fRTS=rtp-smp|fRTS=ravenscar-cert-rtp:-mrtp} "
 #endif
-   "%{gnatea:-gnatez} %{g*&m*&f*} "
-   "%1 %{!S:%{o*:%w%*-gnatO}} \
+   "%{Wall:-gnatwa} %{Werror:-gnatwe} %{w:-gnatws} \
+    %{gnatea:-gnatez} %{g*&m*&f*} \
+    %1 %{!S:%{o*:%w%*-gnatO}} \
     %i %{S:%W{o*}%{!o*:-o %w%b.s}} \
     %{gnatc*|gnats*: -o %j} %{-param*} \
     %{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 846d20a..be3f107 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -38,6 +38,7 @@
 #include "attribs.h"
 #include "varasm.h"
 #include "toplev.h"
+#include "opts.h"
 #include "output.h"
 #include "debug.h"
 #include "convert.h"
@@ -109,6 +110,8 @@ static tree handle_target_attribute (tree *, tree, tree, int, bool *);
 static tree handle_target_clones_attribute (tree *, tree, tree, int, bool *);
 static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *);
 static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *);
+static tree handle_zero_call_used_regs_attribute (tree *, tree, tree, int,
+						  bool *);
 
 static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] =
 {
@@ -191,6 +194,9 @@ const struct attribute_spec gnat_internal_attribute_table[] =
   { "may_alias",    0, 0,  false, true,  false, false,
     NULL, NULL },
 
+  { "zero_call_used_regs", 1, 1, true, false, false, false,
+    handle_zero_call_used_regs_attribute, NULL },
+
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
      of the common builtins.def contents.  */
@@ -4329,6 +4335,7 @@ update_pointer_to (tree old_type, tree new_type)
 	    TREE_TYPE (t) = new_type;
 	    if (TYPE_NULL_BOUNDS (t))
 	      TREE_TYPE (TREE_OPERAND (TYPE_NULL_BOUNDS (t), 0)) = new_type;
+	    TYPE_CANONICAL (t) = TYPE_CANONICAL (TYPE_POINTER_TO (new_type));
 	  }
 
       /* Chain REF and its variants at the end.  */
@@ -4345,7 +4352,10 @@ update_pointer_to (tree old_type, tree new_type)
       /* Now adjust them.  */
       for (; ref; ref = TYPE_NEXT_REF_TO (ref))
 	for (t = TYPE_MAIN_VARIANT (ref); t; t = TYPE_NEXT_VARIANT (t))
-	  TREE_TYPE (t) = new_type;
+	  {
+	    TREE_TYPE (t) = new_type;
+	    TYPE_CANONICAL (t) = TYPE_CANONICAL (TYPE_REFERENCE_TO (new_type));
+	  }
 
       TYPE_POINTER_TO (old_type) = NULL_TREE;
       TYPE_REFERENCE_TO (old_type) = NULL_TREE;
@@ -5858,8 +5868,7 @@ can_materialize_object_renaming_p (Node_Id expr)
 
 	    const Uint bitpos
 	      = Normalized_First_Bit (Entity (Selector_Name (expr)));
-	    if (!UI_Is_In_Int_Range (bitpos)
-		|| (bitpos != UI_No_Uint && bitpos != UI_From_Int (0)))
+	    if (bitpos != UI_No_Uint && bitpos != Uint_0)
 	      return false;
 
 	    expr = Prefix (expr);
@@ -6984,6 +6993,59 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   return NULL_TREE;
 }
 
+/* Handle a "zero_call_used_regs" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_zero_call_used_regs_attribute (tree *node, tree name, tree args,
+				      int ARG_UNUSED (flags),
+				      bool *no_add_attrs)
+{
+  tree decl = *node;
+  tree id = TREE_VALUE (args);
+
+  if (TREE_CODE (decl) != FUNCTION_DECL)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"%qE attribute applies only to functions", name);
+      *no_add_attrs = true;
+      return NULL_TREE;
+    }
+
+  /* pragma Machine_Attribute turns string arguments into identifiers.
+     Reverse it.  */
+  if (TREE_CODE (id) == IDENTIFIER_NODE)
+    id = TREE_VALUE (args) = build_string
+      (IDENTIFIER_LENGTH (id), IDENTIFIER_POINTER (id));
+
+  if (TREE_CODE (id) != STRING_CST)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"%qE argument not a string", name);
+      *no_add_attrs = true;
+      return NULL_TREE;
+    }
+
+  bool found = false;
+  for (unsigned int i = 0; zero_call_used_regs_opts[i].name != NULL; ++i)
+    if (strcmp (TREE_STRING_POINTER (id),
+		zero_call_used_regs_opts[i].name) == 0)
+      {
+	found = true;
+	break;
+      }
+
+  if (!found)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"unrecognized %qE attribute argument %qs",
+		name, TREE_STRING_POINTER (id));
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
 /* ----------------------------------------------------------------------- *
  *                              BUILTIN FUNCTIONS                          *
  * ----------------------------------------------------------------------- */
diff --git a/gcc/ada/libgnat/s-aoinar.adb b/gcc/ada/libgnat/s-aoinar.adb
index df12b16..2f430ed 100644
--- a/gcc/ada/libgnat/s-aoinar.adb
+++ b/gcc/ada/libgnat/s-aoinar.adb
@@ -203,7 +203,7 @@ package body System.Atomic_Operations.Integer_Arithmetic is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Integer_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aomoar.adb b/gcc/ada/libgnat/s-aomoar.adb
index c955623..a6f4b0e 100644
--- a/gcc/ada/libgnat/s-aomoar.adb
+++ b/gcc/ada/libgnat/s-aomoar.adb
@@ -209,7 +209,7 @@ package body System.Atomic_Operations.Modular_Arithmetic is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Modular_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aotase.adb b/gcc/ada/libgnat/s-aotase.adb
index 5317889..94b28df 100644
--- a/gcc/ada/libgnat/s-aotase.adb
+++ b/gcc/ada/libgnat/s-aotase.adb
@@ -40,7 +40,7 @@ package body System.Atomic_Operations.Test_And_Set is
    function Atomic_Test_And_Set
      (Item : aliased in out Test_And_Set_Flag) return Boolean is
    begin
-      return Boolean (Atomic_Test_And_Set (Item'Address));
+      return Atomic_Test_And_Set (Item'Address);
    end Atomic_Test_And_Set;
 
    ------------------
diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb
index 501254e..b0aa9e5 100644
--- a/gcc/ada/libgnat/s-atopex.adb
+++ b/gcc/ada/libgnat/s-atopex.adb
@@ -89,36 +89,36 @@ package body System.Atomic_Operations.Exchange is
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1");
       function Atomic_Compare_Exchange_2
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2");
       function Atomic_Compare_Exchange_4
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
       function Atomic_Compare_Exchange_8
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
       pragma Warnings (On);
@@ -126,21 +126,17 @@ package body System.Atomic_Operations.Exchange is
    begin
       case Atomic_Type'Object_Size is
          when 8 =>
-            return Boolean
-              (Atomic_Compare_Exchange_1
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_1 (Item'Address, Prior'Address, Desired);
          when 16 =>
-            return Boolean
-              (Atomic_Compare_Exchange_2
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_2 (Item'Address, Prior'Address, Desired);
          when 32 =>
-            return Boolean
-              (Atomic_Compare_Exchange_4
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_4 (Item'Address, Prior'Address, Desired);
          when 64 =>
-            return Boolean
-              (Atomic_Compare_Exchange_8
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_8 (Item'Address, Prior'Address, Desired);
          when others =>
             raise Program_Error;
       end case;
@@ -154,7 +150,7 @@ package body System.Atomic_Operations.Exchange is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Exchange;
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 2a5ffe5..891b2ed 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -62,9 +62,6 @@ package System.Atomic_Primitives is
 
    subtype Mem_Model is Integer range Relaxed .. Last;
 
-   type bool is new Boolean;
-   pragma Convention (C, bool);
-
    ------------------------------------
    -- GCC built-in atomic primitives --
    ------------------------------------
@@ -137,7 +134,7 @@ package System.Atomic_Primitives is
 
    function Atomic_Test_And_Set
      (Ptr   : System.Address;
-      Model : Mem_Model := Seq_Cst) return bool;
+      Model : Mem_Model := Seq_Cst) return Boolean;
    pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
 
    procedure Atomic_Clear
@@ -147,7 +144,7 @@ package System.Atomic_Primitives is
 
    function Atomic_Always_Lock_Free
      (Size : Interfaces.C.size_t;
-      Ptr  : System.Address := System.Null_Address) return bool;
+      Ptr  : System.Address := System.Null_Address) return Boolean;
    pragma Import
      (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");