cuintp.c (UI_To_gnu): Fix long line.

	* gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
	* gcc-interface/gigi.h (MARK_VISITED): Skip objects of constant class.
	(process_attributes): Delete.
	(post_error_ne_num): Change parameter name.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not force debug info
	with -g3.  Remove a couple of obsolete lines.  Minor tweaks.
	If type annotating mode, operate on trees to compute the adjustment to
	the sizes of tagged types.  Fix long line.
	(cannot_be_superflat_p): Tweak head comment.
	(annotate_value): Fold local constant.
	(set_rm_size): Fix long line.
	* gcc-interface/trans.c (Identifier_to_gnu): Rework comments.
	(Attribute_to_gnu): Fix long line.
	<Attr_Size>: Remove useless assertion.
	Reorder statements.  Use size_binop routine.
	(Loop_Statement_to_gnu): Use build5 in lieu of build_nt.
	Create local variables for the label and the test.  Tweak comments.
	(Subprogram_Body_to_gnu): Reset cfun to NULL.
	(Compilation_Unit_to_gnu): Use the Sloc of the Unit node.
	(process_inlined_subprograms): Integrate into...
	(Compilation_Unit_to_gnu): ...this.
	(gnat_to_gnu): Fix long line.
	(post_error_ne_num): Change parameter name.
	* gcc-interface/utils.c (process_attributes): Static-ify.
	<ATTR_MACHINE_ATTRIBUTE>: Set input_location before proceeding.
	(create_type_decl): Add comment.
	(create_var_decl_1): Process the attributes after adding the VAR_DECL
	to the current binding level.
	(create_subprog_decl): Likewise for the FUNCTION_DECL.
	(end_subprog_body): Do not reset cfun to NULL.
	(build_vms_descriptor32): Fix long line.
	(build_vms_descriptor): Likewise.
	(handle_nonnull_attribute): Likewise.
	(convert_vms_descriptor64): Likewise.
	* gcc-interface/utils2.c (fill_vms_descriptor): Fix long line.
	(gnat_protect_expr): Fix thinko.

From-SVN: r158390

gcc/ada/ChangeLog

 2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
+	* gcc-interface/gigi.h (MARK_VISITED): Skip objects of constant class.
+	(process_attributes): Delete.
+	(post_error_ne_num): Change parameter name.
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not force debug info
+	with -g3.  Remove a couple of obsolete lines.  Minor tweaks.
+	If type annotating mode, operate on trees to compute the adjustment to
+	the sizes of tagged types.  Fix long line.
+	(cannot_be_superflat_p): Tweak head comment.
+	(annotate_value): Fold local constant.
+	(set_rm_size): Fix long line.
+	* gcc-interface/trans.c (Identifier_to_gnu): Rework comments.
+	(Attribute_to_gnu): Fix long line.
+	<Attr_Size>: Remove useless assertion.
+	Reorder statements.  Use size_binop routine.
+	(Loop_Statement_to_gnu): Use build5 in lieu of build_nt.
+	Create local variables for the label and the test.  Tweak comments.
+	(Subprogram_Body_to_gnu): Reset cfun to NULL.
+	(Compilation_Unit_to_gnu): Use the Sloc of the Unit node.
+	(process_inlined_subprograms): Integrate into...
+	(Compilation_Unit_to_gnu): ...this.
+	(gnat_to_gnu): Fix long line.
+	(post_error_ne_num): Change parameter name.
+	* gcc-interface/utils.c (process_attributes): Static-ify.
+	<ATTR_MACHINE_ATTRIBUTE>: Set input_location before proceeding.
+	(create_type_decl): Add comment.
+	(create_var_decl_1): Process the attributes after adding the VAR_DECL
+	to the current binding level.
+	(create_subprog_decl): Likewise for the FUNCTION_DECL.
+	(end_subprog_body): Do not reset cfun to NULL.
+	(build_vms_descriptor32): Fix long line.
+	(build_vms_descriptor): Likewise.
+	(handle_nonnull_attribute): Likewise.
+	(convert_vms_descriptor64): Likewise.
+	* gcc-interface/utils2.c (fill_vms_descriptor): Fix long line.
+	(gnat_protect_expr): Fix thinko.
+
+2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions.
 	(gnat_to_gnu) <N_Op_Eq>: Restore the value of input_location
 	before translating the top-level node.

gcc/ada/gcc-interface/cuintp.c

@@ -106,7 +106,8 @@ UI_To_gnu (Uint Input, tree type)
 	 The base integer precision must be superior than 16.  */
 
       if (TREE_CODE (comp_type) != REAL_TYPE
-	  && TYPE_PRECISION (comp_type) < TYPE_PRECISION (long_integer_type_node))
+	  && TYPE_PRECISION (comp_type)
+	     < TYPE_PRECISION (long_integer_type_node))
 	{
 	  comp_type = long_integer_type_node;
 	  gcc_assert (TYPE_PRECISION (comp_type) > 16);

gcc/ada/gcc-interface/decl.c

@@ -207,8 +207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
   /* True if we made GNU_DECL and its type here.  */
   bool this_made_decl = false;
   /* True if debug info is requested for this entity.  */
-  bool debug_info_p = (Needs_Debug_Info (gnat_entity)
-		       || debug_info_level == DINFO_LEVEL_VERBOSE);
+  bool debug_info_p = Needs_Debug_Info (gnat_entity);
   /* True if this entity is to be considered as imported.  */
   bool imported_p = (Is_Imported (gnat_entity)
 		     && No (Address_Clause (gnat_entity)));
@@ -983,8 +982,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			   as we have a VAR_DECL for the pointer we make.  */
 		      }
 
-		    gnu_expr
-		      = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
+		    gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
+					       maybe_stable_expr);
 
 		    gnu_size = NULL_TREE;
 		    used_by_ref = true;
@@ -1291,10 +1290,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			|| Is_Exported (gnat_entity)))))
 	  gnu_ext_name = create_concat_name (gnat_entity, NULL);
 
-	/* If this is constant initialized to a static constant and the
-	   object has an aggregate type, force it to be statically
-	   allocated.  This will avoid an initialization copy.  */
-	if (!static_p && const_flag
+	/* If this is an aggregate constant initialized to a constant, force it
+	   to be statically allocated.  This saves an initialization copy.  */
+	if (!static_p
+	    && const_flag
 	    && gnu_expr && TREE_CONSTANT (gnu_expr)
 	    && AGGREGATE_TYPE_P (gnu_type)
 	    && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
@@ -1303,11 +1302,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				    (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
 	  static_p = true;
 
-	gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
-				    gnu_expr, const_flag,
-				    Is_Public (gnat_entity),
-				    imported_p || !definition,
-				    static_p, attr_list, gnat_entity);
+	gnu_decl
+	  = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
+			     gnu_expr, const_flag, Is_Public (gnat_entity),
+			     imported_p || !definition, static_p, attr_list,
+			     gnat_entity);
 	DECL_BY_REF_P (gnu_decl) = used_by_ref;
 	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
 	if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
@@ -3473,7 +3472,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
 		TYPE_POINTER_TO (gnu_old) = gnu_type;
 
-		Sloc_to_locus (Sloc (gnat_entity), &input_location);
 		fields
 		  = chainon (chainon (NULL_TREE,
 				      create_field_decl
@@ -4170,8 +4168,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				  | (TYPE_QUAL_CONST * const_flag)
 				  | (TYPE_QUAL_VOLATILE * volatile_flag));
 
-	Sloc_to_locus (Sloc (gnat_entity), &input_location);
-
 	if (has_stub)
 	  gnu_stub_type
 	    = build_qualified_type (gnu_stub_type,
@@ -4705,38 +4701,40 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
       if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
 	{
-	  /* If the size is self-referential, we annotate the maximum
-	     value of that size.  */
 	  tree gnu_size = TYPE_SIZE (gnu_type);
 
+	  /* If the size is self-referential, annotate the maximum value.  */
 	  if (CONTAINS_PLACEHOLDER_P (gnu_size))
 	    gnu_size = max_size (gnu_size, true);
 
-	  Set_Esize (gnat_entity, annotate_value (gnu_size));
-
 	  if (type_annotate_only && Is_Tagged_Type (gnat_entity))
 	    {
-	      /* In this mode the tag and the parent components are not
-		 generated by the front-end, so the sizes must be adjusted
-		 explicitly now.  */
-	      int size_offset, new_size;
+	      /* In this mode, the tag and the parent components are not
+		 generated by the front-end so the sizes must be adjusted.  */
+	      tree pointer_size = bitsize_int (POINTER_SIZE), offset;
+	      Uint uint_size;
 
 	      if (Is_Derived_Type (gnat_entity))
 		{
-		  size_offset
-		    = UI_To_Int (Esize (Etype (Base_Type (gnat_entity))));
+		  offset = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
+				      bitsizetype);
 		  Set_Alignment (gnat_entity,
 				 Alignment (Etype (Base_Type (gnat_entity))));
 		}
 	      else
-		size_offset = POINTER_SIZE;
-
-	      new_size = UI_To_Int (Esize (gnat_entity)) + size_offset;
-	      Set_Esize (gnat_entity,
-			 UI_From_Int (((new_size + (POINTER_SIZE - 1))
-				       / POINTER_SIZE) * POINTER_SIZE));
-	      Set_RM_Size (gnat_entity, Esize (gnat_entity));
+		offset = pointer_size;
+
+	      gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
+	      gnu_size = size_binop (MULT_EXPR, pointer_size,
+						size_binop (CEIL_DIV_EXPR,
+							    gnu_size,
+							    pointer_size));
+	      uint_size = annotate_value (gnu_size);
+	      Set_Esize (gnat_entity, uint_size);
+	      Set_RM_Size (gnat_entity, uint_size);
 	    }
+	  else
+	    Set_Esize (gnat_entity, annotate_value (gnu_size));
 	}
 
       if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type))
@@ -5366,15 +5364,14 @@ compile_time_known_address_p (Node_Id gnat_address)
   return Compile_Time_Known_Value (gnat_address);
 }
 
-/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e.
-   cannot verify HB < LB-1 when LB and HB are the low and high bounds.  */
+/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e. if the
+   inequality HB >= LB-1 is true.  LB and HB are the low and high bounds.  */
 
 static bool
 cannot_be_superflat_p (Node_Id gnat_range)
 {
   Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
   Node_Id scalar_range;
-
   tree gnu_lb, gnu_hb;
 
   /* If the low bound is not constant, try to find an upper bound.  */
@@ -7087,12 +7084,10 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
 static Uint
 annotate_value (tree gnu_size)
 {
-  int len = TREE_CODE_LENGTH (TREE_CODE (gnu_size));
   TCode tcode;
   Node_Ref_Or_Val ops[3], ret;
-  int i;
-  int size;
   struct tree_int_map **h = NULL;
+  int size, i;
 
   /* See if we've already saved the value for this node.  */
   if (EXPR_P (gnu_size))
@@ -7223,7 +7218,7 @@ annotate_value (tree gnu_size)
   for (i = 0; i < 3; i++)
     ops[i] = No_Uint;
 
-  for (i = 0; i < len; i++)
+  for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
     {
       ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
       if (ops[i] == No_Uint)
@@ -7675,7 +7670,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
 	       && TYPE_PACKED_ARRAY_TYPE_P (gnu_type))
 	  && !(TYPE_IS_PADDING_P (gnu_type)
 	       && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == ARRAY_TYPE
-	       && TYPE_PACKED_ARRAY_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_type))))
+	       && TYPE_PACKED_ARRAY_TYPE_P
+		  (TREE_TYPE (TYPE_FIELDS (gnu_type))))
 	  && tree_int_cst_lt (size, old_size)))
     {
       if (Present (gnat_attr_node))

gcc/ada/gcc-interface/gigi.h

@@ -85,7 +85,7 @@ extern void mark_visited (tree t);
 
 #define MARK_VISITED(EXP)		\
 do {					\
-  if((EXP) && !TREE_CONSTANT (EXP))	\
+  if((EXP) && !CONSTANT_CLASS_P (EXP))	\
     mark_visited (EXP);			\
 } while (0)
 
@@ -240,9 +240,9 @@ extern void post_error (const char *msg, Node_Id node);
 extern void post_error_ne (const char *msg, Node_Id node, Entity_Id ent);
 
 /* Similar, but NODE is the node at which to post the error, ENT is the node
-   to use for the "&" substitution, and N is the number to use for the ^.  */
+   to use for the "&" substitution, and NUM is the number to use for ^.  */
 extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
-                               int n);
+                               int num);
 
 /* Similar to post_error_ne_num, but T is a GCC tree representing the number
    to write.  If the tree represents a constant that fits within a
@@ -252,8 +252,8 @@ extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
 extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
                                 tree t);
 
-/* Similar to post_error_ne_tree, except that NUM is a second
-   integer to write in the message.  */
+/* Similar to post_error_ne_tree, except that NUM is a second integer to write
+   in the message.  */
 extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
                                   tree t, int num);
 
@@ -622,9 +622,6 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
 		     const_flag, public_flag, extern_flag,		\
 		     static_flag, false, attr_list, gnat_node)
 
-/* Given a DECL and ATTR_LIST, apply the listed attributes.  */
-extern void process_attributes (tree decl, struct attrib *attr_list);
-
 /* Record DECL as a global renaming pointer.  */
 extern void record_global_renaming_pointer (tree decl);
 

gcc/ada/gcc-interface/trans.c

@@ -200,7 +200,6 @@ static void pop_stack (tree *);
 static enum gimplify_status gnat_gimplify_stmt (tree *);
 static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
-static void process_inlined_subprograms (Node_Id);
 static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
 static tree emit_range_check (tree, Node_Id, Node_Id);
 static tree emit_index_check (tree, tree, tree, tree, Node_Id);
@@ -1034,10 +1033,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
     }
 
-  /* If we have a constant declaration and its initializer at hand,
-     try to return the latter to avoid the need to call fold in lots
-     of places and the need of elaboration code if this Id is used as
-     an initializer itself.  */
+  /* If we have a constant declaration and its initializer, try to return the
+     latter to avoid the need to call fold in lots of places and the need for
+     elaboration code if this identifier is used as an initializer itself.  */
   if (TREE_CONSTANT (gnu_result)
       && DECL_P (gnu_result)
       && DECL_INITIAL (gnu_result))
@@ -1055,11 +1053,15 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	  = lvalue_required_p (gnat_node, gnu_result_type, true,
 			       address_of_constant, Is_Aliased (gnat_temp));
 
+      /* ??? We need to unshare the initializer if the object is external
+	 as such objects are not marked for unsharing if we are not at the
+	 global level.  This should be fixed in add_decl_expr.  */
       if ((constant_only && !address_of_constant) || !require_lvalue)
 	gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
   *gnu_result_type_p = gnu_result_type;
+
   return gnu_result;
 }
 
@@ -1357,7 +1359,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	    tree gnu_byte_offset
 	      = convert (sizetype,
 			 size_diffop (size_zero_node, gnu_pos));
-	    gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+	    gnu_byte_offset
+	      = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
 
 	    gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
 	    gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
@@ -1456,17 +1459,14 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       else
 	gnu_result = rm_size (gnu_type);
 
-      gcc_assert (gnu_result);
-
       /* Deal with a self-referential size by returning the maximum size for
-	 a type and by qualifying the size with the object for 'Size of an
-	 object.  */
+	 a type and by qualifying the size with the object otherwise.  */
       if (CONTAINS_PLACEHOLDER_P (gnu_result))
 	{
-	  if (TREE_CODE (gnu_prefix) != TYPE_DECL)
-	    gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
-	  else
+	  if (TREE_CODE (gnu_prefix) == TYPE_DECL)
 	    gnu_result = max_size (gnu_result, true);
+	  else
+	    gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
 	}
 
       /* If the type contains a template, subtract its size.  */
@@ -1475,11 +1475,11 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	gnu_result = size_binop (MINUS_EXPR, gnu_result,
 				 DECL_SIZE (TYPE_FIELDS (gnu_type)));
 
-      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
+      /* For 'Max_Size_In_Storage_Elements, adjust the unit.  */
       if (attribute == Attr_Max_Size_In_Storage_Elements)
-	gnu_result = fold_build2 (CEIL_DIV_EXPR, bitsizetype,
-				  gnu_result, bitsize_unit_node);
+	gnu_result = size_binop (CEIL_DIV_EXPR, gnu_result, bitsize_unit_node);
+
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
       break;
 
     case Attr_Alignment:
@@ -2052,25 +2052,22 @@ Case_Statement_to_gnu (Node_Id gnat_node)
 static tree
 Loop_Statement_to_gnu (Node_Id gnat_node)
 {
-  /* ??? It would be nice to use "build" here, but there's no build5.  */
-  tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE,
-				 NULL_TREE, NULL_TREE, NULL_TREE);
-  tree gnu_loop_var = NULL_TREE;
-  Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
-  tree gnu_cond_expr = NULL_TREE;
+  const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
+  tree gnu_loop_stmt = build5 (LOOP_STMT, void_type_node, NULL_TREE,
+			       NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE);
+  tree gnu_loop_label = create_artificial_label (input_location);
+  tree gnu_loop_var = NULL_TREE, gnu_cond_expr = NULL_TREE;
   tree gnu_result;
 
-  TREE_TYPE (gnu_loop_stmt) = void_type_node;
-  TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
-  LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label (input_location);
+  /* Set location information for statement and end label.  */
   set_expr_location_from_node (gnu_loop_stmt, gnat_node);
   Sloc_to_locus (Sloc (End_Label (gnat_node)),
-		 &DECL_SOURCE_LOCATION (LOOP_STMT_LABEL (gnu_loop_stmt)));
+		 &DECL_SOURCE_LOCATION (gnu_loop_label));
+  LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
 
-  /* Save the end label of this LOOP_STMT in a stack so that the corresponding
+  /* Save the end label of this LOOP_STMT in a stack so that a corresponding
      N_Exit_Statement can find it.  */
-  push_stack (&gnu_loop_label_stack, NULL_TREE,
-	      LOOP_STMT_LABEL (gnu_loop_stmt));
+  push_stack (&gnu_loop_label_stack, NULL_TREE, gnu_loop_label);
 
   /* Set the condition under which the loop must keep going.
      For the case "LOOP .... END LOOP;" the condition is always true.  */
@@ -2082,8 +2079,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
     LOOP_STMT_TOP_COND (gnu_loop_stmt)
       = gnat_to_gnu (Condition (gnat_iter_scheme));
 
-  /* Otherwise we have an iteration scheme and the condition is given by
-     the bounds of the subtype of the iteration variable.  */
+  /* Otherwise we have an iteration scheme and the condition is given by the
+     bounds of the subtype of the iteration variable.  */
   else
     {
       Node_Id gnat_loop_spec = Loop_Parameter_Specification (gnat_iter_scheme);
@@ -2092,18 +2089,18 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       tree gnu_type = get_unpadded_type (gnat_type);
       tree gnu_low = TYPE_MIN_VALUE (gnu_type);
       tree gnu_high = TYPE_MAX_VALUE (gnu_type);
-      tree gnu_first, gnu_last, gnu_limit;
-      enum tree_code update_code, end_code;
       tree gnu_base_type = get_base_type (gnu_type);
+      tree gnu_first, gnu_last, gnu_limit, gnu_test;
+      enum tree_code update_code, test_code;
 
-      /* We must disable modulo reduction for the loop variable, if any,
+      /* We must disable modulo reduction for the iteration variable, if any,
 	 in order for the loop comparison to be effective.  */
       if (Reverse_Present (gnat_loop_spec))
 	{
 	  gnu_first = gnu_high;
 	  gnu_last = gnu_low;
 	  update_code = MINUS_NOMOD_EXPR;
-	  end_code = GE_EXPR;
+	  test_code = GE_EXPR;
 	  gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
 	}
       else
@@ -2111,14 +2108,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 	  gnu_first = gnu_low;
 	  gnu_last = gnu_high;
 	  update_code = PLUS_NOMOD_EXPR;
-	  end_code = LE_EXPR;
+	  test_code = LE_EXPR;
 	  gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
 	}
 
-      /* We know the loop variable will not overflow if GNU_LAST is a constant
-	 and is not equal to GNU_LIMIT.  If it might overflow, we have to move
-	 the limit test to the end of the loop.  In that case, we have to test
-	 for an empty loop outside the loop.  */
+      /* We know that the iteration variable will not overflow if GNU_LAST is
+	 a constant and is not equal to GNU_LIMIT.  If it might overflow, we
+	 have to turn the limit test into an inequality test and move it to
+	 the end of the loop; as a consequence, we also have to test for an
+	 empty loop before entering it.  */
       if (TREE_CODE (gnu_last) != INTEGER_CST
 	  || TREE_CODE (gnu_limit) != INTEGER_CST
 	  || tree_int_cst_equal (gnu_last, gnu_limit))
@@ -2129,32 +2127,30 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 				       gnu_low, gnu_high),
 		      NULL_TREE, alloc_stmt_list ());
 	  set_expr_location_from_node (gnu_cond_expr, gnat_loop_spec);
+	  test_code = NE_EXPR;
 	}
 
       /* Open a new nesting level that will surround the loop to declare the
-	 loop index variable.  */
+	 iteration variable.  */
       start_stmt_group ();
       gnat_pushlevel ();
 
-      /* Declare the loop index and set it to its initial value.  */
+      /* Declare the iteration variable and set it to its initial value.  */
       gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
       if (DECL_BY_REF_P (gnu_loop_var))
 	gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var);
 
-      /* The loop variable might be a padded type, so use `convert' to get a
-	 reference to the inner variable if so.  */
-      gnu_loop_var = convert (get_base_type (gnu_type), gnu_loop_var);
+      /* Do all the arithmetics in the base type.  */
+      gnu_loop_var = convert (gnu_base_type, gnu_loop_var);
 
       /* Set either the top or bottom exit condition as appropriate depending
 	 on whether or not we know an overflow cannot occur.  */
+      gnu_test = build_binary_op (test_code, integer_type_node, gnu_loop_var,
+				  gnu_last);
       if (gnu_cond_expr)
-	LOOP_STMT_BOT_COND (gnu_loop_stmt)
-	  = build_binary_op (NE_EXPR, integer_type_node,
-			     gnu_loop_var, gnu_last);
+	LOOP_STMT_BOT_COND (gnu_loop_stmt) = gnu_test;
       else
-	LOOP_STMT_TOP_COND (gnu_loop_stmt)
-	  = build_binary_op (end_code, integer_type_node,
-			     gnu_loop_var, gnu_last);
+	LOOP_STMT_TOP_COND (gnu_loop_stmt) = gnu_test;
 
       LOOP_STMT_UPDATE (gnu_loop_stmt)
 	= build_binary_op (MODIFY_EXPR, NULL_TREE,
@@ -2169,16 +2165,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
     }
 
   /* If the loop was named, have the name point to this loop.  In this case,
-     the association is not a ..._DECL node, but the end label from this
-     LOOP_STMT.  */
+     the association is not a DECL node, but the end label of the loop.  */
   if (Present (Identifier (gnat_node)))
-    save_gnu_tree (Entity (Identifier (gnat_node)),
-		   LOOP_STMT_LABEL (gnu_loop_stmt), true);
+    save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_label, true);
 
   /* Make the loop body into its own block, so any allocated storage will be
      released every iteration.  This is needed for stack allocation.  */
   LOOP_STMT_BODY (gnu_loop_stmt)
     = build_stmt_group (Statements (gnat_node), true);
+  TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
 
   /* If we declared a variable, then we are in a statement group for that
      declaration.  Add the LOOP_STMT to it and make that the "loop".  */
@@ -2325,13 +2320,14 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
   allocate_struct_function (gnu_subprog_decl, false);
   DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language
     = GGC_CNEW (struct language_function);
+  set_cfun (NULL);
 
   begin_subprog_body (gnu_subprog_decl);
-  gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
 
   /* If there are Out parameters, we need to ensure that the return statement
      properly copies them out.  We do this by making a new block and converting
      any inner return into a goto to a label at the end of the block.  */
+  gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
   push_stack (&gnu_return_label_stack, NULL_TREE,
 	      gnu_cico_list ? create_artificial_label (input_location)
 	      : NULL_TREE);
@@ -3422,26 +3418,26 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
 static void
 Compilation_Unit_to_gnu (Node_Id gnat_node)
 {
+  const Node_Id gnat_unit = Unit (gnat_node);
+  const bool body_p = (Nkind (gnat_unit) == N_Package_Body
+		       || Nkind (gnat_unit) == N_Subprogram_Body);
+  const Entity_Id gnat_unit_entity = Defining_Entity (gnat_unit);
   /* Make the decl for the elaboration procedure.  */
-  bool body_p = (Defining_Entity (Unit (gnat_node)),
-	    Nkind (Unit (gnat_node)) == N_Package_Body
-	    || Nkind (Unit (gnat_node)) == N_Subprogram_Body);
-  Entity_Id gnat_unit_entity = Defining_Entity (Unit (gnat_node));
   tree gnu_elab_proc_decl
     = create_subprog_decl
-      (create_concat_name (gnat_unit_entity,
-			   body_p ? "elabb" : "elabs"),
-       NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL,
-       gnat_unit_entity);
+      (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"),
+       NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL, gnat_unit);
   struct elab_info *info;
 
   push_stack (&gnu_elab_proc_stack, NULL_TREE, gnu_elab_proc_decl);
-
   DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
+
+  /* Initialize the information structure for the function.  */
   allocate_struct_function (gnu_elab_proc_decl, false);
-  Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
-  current_function_decl = NULL_TREE;
   set_cfun (NULL);
+
+  current_function_decl = NULL_TREE;
+
   start_stmt_group ();
   gnat_pushlevel ();
 
@@ -3454,7 +3450,34 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
       finalize_from_with_types ();
     }
 
-  process_inlined_subprograms (gnat_node);
+  /* If we can inline, generate code for all the inlined subprograms.  */
+  if (optimize)
+    {
+      Entity_Id gnat_entity;
+
+      for (gnat_entity = First_Inlined_Subprogram (gnat_node);
+	   Present (gnat_entity);
+	   gnat_entity = Next_Inlined_Subprogram (gnat_entity))
+	{
+	  Node_Id gnat_body = Parent (Declaration_Node (gnat_entity));
+
+	  if (Nkind (gnat_body) != N_Subprogram_Body)
+	    {
+	      /* ??? This really should always be present.  */
+	      if (No (Corresponding_Body (gnat_body)))
+		continue;
+	      gnat_body
+		= Parent (Declaration_Node (Corresponding_Body (gnat_body)));
+	    }
+
+	  if (Present (gnat_body))
+	    {
+	      /* Define the entity first so we set DECL_EXTERNAL.  */
+	      gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
+	      add_stmt (gnat_to_gnu (gnat_body));
+	    }
+	}
+    }
 
   if (type_annotate_only && gnat_node == Cunit (Main_Unit))
     {
@@ -3481,6 +3504,11 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
   set_current_block_context (gnu_elab_proc_decl);
   gnat_poplevel ();
   DECL_SAVED_TREE (gnu_elab_proc_decl) = end_stmt_group ();
+
+  Sloc_to_locus
+    (Sloc (gnat_unit),
+     &DECL_STRUCT_FUNCTION (gnu_elab_proc_decl)->function_end_locus);
+
   info->next = elab_info_list;
   info->elab_proc = gnu_elab_proc_decl;
   info->gnat_node = gnat_node;
@@ -5220,7 +5248,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		gnu_actual_obj_type
 		  = build_unc_object_type_from_ptr (gnu_ptr_type,
 						    gnu_actual_obj_type,
-						    get_identifier ("DEALLOC"));
+						    get_identifier
+						    ("DEALLOC"));
 	    }
 	  else
 	    gnu_actual_obj_type = gnu_obj_type;
@@ -5235,7 +5264,8 @@ gnat_to_gnu (Node_Id gnat_node)
 	      tree gnu_byte_offset
 		= convert (sizetype,
 			   size_diffop (size_zero_node, gnu_pos));
-	      gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+	      gnu_byte_offset
+		= fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
 
 	      gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
 	      gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
@@ -6219,42 +6249,6 @@ process_freeze_entity (Node_Id gnat_node)
 		       TREE_TYPE (gnu_new));
 }
 
-/* Process the list of inlined subprograms of GNAT_NODE, which is an
-   N_Compilation_Unit.  */
-
-static void
-process_inlined_subprograms (Node_Id gnat_node)
-{
-  Entity_Id gnat_entity;
-  Node_Id gnat_body;
-
-  /* If we can inline, generate Gimple for all the inlined subprograms.
-     Define the entity first so we set DECL_EXTERNAL.  */
-  if (optimize > 0)
-    for (gnat_entity = First_Inlined_Subprogram (gnat_node);
-	 Present (gnat_entity);
-	 gnat_entity = Next_Inlined_Subprogram (gnat_entity))
-      {
-	gnat_body = Parent (Declaration_Node (gnat_entity));
-
-	if (Nkind (gnat_body) != N_Subprogram_Body)
-	  {
-	    /* ??? This really should always be Present.  */
-	    if (No (Corresponding_Body (gnat_body)))
-	      continue;
-
-	    gnat_body
-	      = Parent (Declaration_Node (Corresponding_Body (gnat_body)));
-	  }
-
-	if (Present (gnat_body))
-	  {
-	    gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
-	    add_stmt (gnat_to_gnu (gnat_body));
-	  }
-      }
-}
-
 /* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
    We make two passes, one to elaborate anything other than bodies (but
    we declare a function if there was no spec).  The second pass
@@ -7428,17 +7422,17 @@ post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
 }
 
 /* Similar, but NODE is the node at which to post the error, ENT is the node
-   to use for the "&" substitution, and N is the number to use for the ^.  */
+   to use for the "&" substitution, and NUM is the number to use for ^.  */
 
 void
-post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int n)
+post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int num)
 {
   String_Template temp;
   Fat_Pointer fp;
 
   temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
   fp.Array = msg, fp.Bounds = &temp;
-  Error_Msg_Uint_1 = UI_From_Int (n);
+  Error_Msg_Uint_1 = UI_From_Int (num);
 
   if (Present (node))
     Error_Msg_NE (fp, node, ent);
@@ -7495,8 +7489,8 @@ post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
     Error_Msg_NE (fp, node, ent);
 }
 
-/* Similar to post_error_ne_tree, except that NUM is a second
-   integer to write in the message.  */
+/* Similar to post_error_ne_tree, except that NUM is a second integer to write
+   in the message.  */
 
 void
 post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,

gcc/ada/gcc-interface/utils.c

@@ -203,6 +203,7 @@ static tree convert_to_fat_pointer (tree, tree);
 static tree convert_to_thin_pointer (tree, tree);
 static tree make_descriptor_field (const char *,tree, tree, tree);
 static bool potential_alignment_gap (tree, tree, tree);
+static void process_attributes (tree, struct attrib *);
 
 /* Initialize the association of GNAT nodes to GCC trees.  */
 
@@ -1283,7 +1284,10 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
 			    TYPE_DECL, type_name, type);
 
   DECL_ARTIFICIAL (type_decl) = artificial_p;
+
+  /* Add this decl to the current binding level.  */
   gnat_pushdecl (type_decl, gnat_node);
+
   process_attributes (type_decl, attr_list);
 
   /* If we're naming the type, equate the TYPE_STUB_DECL to the name.
@@ -1413,21 +1417,17 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
 	   != null_pointer_node)
     DECL_IGNORED_P (var_decl) = 1;
 
-  if (TREE_CODE (var_decl) == VAR_DECL)
-    {
-      if (asm_name)
-	SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
-      process_attributes (var_decl, attr_list);
-    }
-
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (var_decl, gnat_node);
 
   if (TREE_SIDE_EFFECTS (var_decl))
     TREE_ADDRESSABLE (var_decl) = 1;
 
-  if (TREE_CODE (var_decl) != CONST_DECL)
+  if (TREE_CODE (var_decl) == VAR_DECL)
     {
+      if (asm_name)
+	SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+      process_attributes (var_decl, attr_list);
       if (global_bindings_p ())
 	rest_of_decl_compilation (var_decl, true, 0);
     }
@@ -1647,13 +1647,14 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
 
 /* Given a DECL and ATTR_LIST, process the listed attributes.  */
 
-void
+static void
 process_attributes (tree decl, struct attrib *attr_list)
 {
   for (; attr_list; attr_list = attr_list->next)
     switch (attr_list->type)
       {
       case ATTR_MACHINE_ATTRIBUTE:
+	input_location = DECL_SOURCE_LOCATION (decl);
 	decl_attributes (&decl, tree_cons (attr_list->name, attr_list->args,
 					   NULL_TREE),
 			 ATTR_FLAG_TYPE_IN_PLACE);
@@ -1863,11 +1864,11 @@ create_subprog_decl (tree subprog_name, tree asm_name,
 	DECL_NAME (subprog_decl) = main_identifier_node;
     }
 
-  process_attributes (subprog_decl, attr_list);
-
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (subprog_decl, gnat_node);
 
+  process_attributes (subprog_decl, attr_list);
+
   /* Output the assembler code and/or RTL for the declaration.  */
   rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0);
 
@@ -1883,9 +1884,10 @@ begin_subprog_body (tree subprog_decl)
 {
   tree param_decl;
 
-  current_function_decl = subprog_decl;
   announce_function (subprog_decl);
 
+  current_function_decl = subprog_decl;
+
   /* Enter a new binding level and show that all the parameters belong to
      this function.  */
   gnat_pushlevel ();
@@ -1926,7 +1928,6 @@ end_subprog_body (tree body)
   DECL_SAVED_TREE (fndecl) = body;
 
   current_function_decl = DECL_CONTEXT (fndecl);
-  set_cfun (NULL);
 
   /* We cannot track the location of errors past this point.  */
   error_gnat_node = Empty;
@@ -2329,12 +2330,12 @@ build_template (tree template_type, tree array_type, tree expr)
   return gnat_build_constructor (template_type, nreverse (template_elts));
 }
 
-/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify
-   a descriptor type, and the GCC type of an object.  Each FIELD_DECL
-   in the type contains in its DECL_INITIAL the expression to use when
-   a constructor is made for the type.  GNAT_ENTITY is an entity used
-   to print out an error message if the mechanism cannot be applied to
-   an object of that type and also for the name.  */
+/* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a
+   descriptor type, and the GCC type of an object.  Each FIELD_DECL in the
+   type contains in its DECL_INITIAL the expression to use when a constructor
+   is made for the type.  GNAT_ENTITY is an entity used to print out an error
+   message if the mechanism cannot be applied to an object of that type and
+   also for the name.  */
 
 tree
 build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
@@ -2473,25 +2474,24 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       break;
     }
 
-  /* Make the type for a descriptor for VMS.  The first four fields
-     are the same for all types.  */
-
+  /* Make the type for a descriptor for VMS.  The first four fields are the
+     same for all types.  */
+  field_list
+    = chainon (field_list,
+	       make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1),
+				      record_type,
+				      size_in_bytes
+				      ((mech == By_Descriptor_A
+					|| mech == By_Short_Descriptor_A)
+				       ? inner_type : type)));
   field_list
     = chainon (field_list,
-	       make_descriptor_field
-	       ("LENGTH", gnat_type_for_size (16, 1), record_type,
-		size_in_bytes ((mech == By_Descriptor_A ||
-                                mech == By_Short_Descriptor_A)
-                               ? inner_type : type)));
-
-  field_list = chainon (field_list,
-			make_descriptor_field ("DTYPE",
-					       gnat_type_for_size (8, 1),
-					       record_type, size_int (dtype)));
-  field_list = chainon (field_list,
-			make_descriptor_field ("CLASS",
-					       gnat_type_for_size (8, 1),
-					       record_type, size_int (klass)));
+	       make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+				      record_type, size_int (dtype)));
+  field_list
+    = chainon (field_list,
+	       make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+				      record_type, size_int (klass)));
 
   /* Of course this will crash at run-time if the address space is not
      within the low 32 bits, but there is nothing else we can do.  */
@@ -2499,11 +2499,11 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 
   field_list
     = chainon (field_list,
-	       make_descriptor_field
-	       ("POINTER", pointer32_type, record_type,
-		build_unary_op (ADDR_EXPR,
-				pointer32_type,
-				build0 (PLACEHOLDER_EXPR, type))));
+	       make_descriptor_field ("POINTER", pointer32_type, record_type,
+				      build_unary_op (ADDR_EXPR,
+						      pointer32_type,
+						      build0 (PLACEHOLDER_EXPR,
+							      type))));
 
   switch (mech)
     {
@@ -2644,12 +2644,12 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   return record_type;
 }
 
-/* Build a 64bit VMS descriptor from a Mechanism_Type, which must specify
-   a descriptor type, and the GCC type of an object.  Each FIELD_DECL
-   in the type contains in its DECL_INITIAL the expression to use when
-   a constructor is made for the type.  GNAT_ENTITY is an entity used
-   to print out an error message if the mechanism cannot be applied to
-   an object of that type and also for the name.  */
+/* Build a 64-bit VMS descriptor from a Mechanism_Type, which must specify a
+   descriptor type, and the GCC type of an object.  Each FIELD_DECL in the
+   type contains in its DECL_INITIAL the expression to use when a constructor
+   is made for the type.  GNAT_ENTITY is an entity used to print out an error
+   message if the mechanism cannot be applied to an object of that type and
+   also for the name.  */
 
 tree
 build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
@@ -2783,43 +2783,41 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       break;
     }
 
-  /* Make the type for a 64bit descriptor for VMS.  The first six fields
+  /* Make the type for a 64-bit descriptor for VMS.  The first six fields
      are the same for all types.  */
-
-  field_list64 = chainon (field_list64,
-			make_descriptor_field ("MBO",
-                                               gnat_type_for_size (16, 1),
-                                               record64_type, size_int (1)));
-
-  field_list64 = chainon (field_list64,
-			make_descriptor_field ("DTYPE",
-					       gnat_type_for_size (8, 1),
-					       record64_type, size_int (dtype)));
-  field_list64 = chainon (field_list64,
-			make_descriptor_field ("CLASS",
-					       gnat_type_for_size (8, 1),
-					       record64_type, size_int (klass)));
-
-  field_list64 = chainon (field_list64,
-			make_descriptor_field ("MBMO",
-                                               gnat_type_for_size (32, 1),
-                                               record64_type, ssize_int (-1)));
-
   field_list64
     = chainon (field_list64,
-	       make_descriptor_field
-	       ("LENGTH", gnat_type_for_size (64, 1), record64_type,
-		size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
+	       make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
+				      record64_type, size_int (1)));
+  field_list64
+    = chainon (field_list64,
+	       make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+				      record64_type, size_int (dtype)));
+  field_list64
+    = chainon (field_list64,
+	       make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+				      record64_type, size_int (klass)));
+  field_list64
+    = chainon (field_list64,
+	       make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
+				      record64_type, ssize_int (-1)));
+  field_list64
+    = chainon (field_list64,
+	       make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
+				      record64_type,
+				      size_in_bytes (mech == By_Descriptor_A
+						     ? inner_type : type)));
 
   pointer64_type = build_pointer_type_for_mode (type, DImode, false);
 
   field_list64
     = chainon (field_list64,
-	       make_descriptor_field
-	       ("POINTER", pointer64_type, record64_type,
-		build_unary_op (ADDR_EXPR,
-				pointer64_type,
-				build0 (PLACEHOLDER_EXPR, type))));
+	       make_descriptor_field ("POINTER", pointer64_type,
+				      record64_type,
+				      build_unary_op (ADDR_EXPR,
+						      pointer64_type,
+						      build0 (PLACEHOLDER_EXPR,
+							      type))));
 
   switch (mech)
     {
@@ -2983,11 +2981,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   /* The CLASS field is the 3rd field in the descriptor.  */
   tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
   /* The POINTER field is the 6th field in the descriptor.  */
-  tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
+  tree pointer = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
 
   /* Retrieve the value of the POINTER field.  */
   tree gnu_expr64
-    = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
+    = build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
 
   if (POINTER_TYPE_P (gnu_type))
     return convert (gnu_type, gnu_expr64);
@@ -3033,7 +3031,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 	  /* If so, there is already a template in the descriptor and
 	     it is located right after the POINTER field.  The fields are
              64bits so they must be repacked. */
-	  t = TREE_CHAIN (pointer64);
+	  t = TREE_CHAIN (pointer);
           lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
           lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
 
@@ -3058,7 +3056,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 	case 4:  /* Class A */
 	  /* The AFLAGS field is the 3rd field after the pointer in the
              descriptor.  */
-	  t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
+	  t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer)));
 	  aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
 	  /* The DIMCT field is the next field in the descriptor after
              aflags.  */
@@ -5084,7 +5082,8 @@ handle_nonnull_attribute (tree *node, tree ARG_UNUSED (name),
 	  if (!argument
 	      || TREE_CODE (TREE_VALUE (argument)) == VOID_TYPE)
 	    {
-	      error ("nonnull argument with out-of-range operand number (argument %lu, operand %lu)",
+	      error ("nonnull argument with out-of-range operand number "
+		     "(argument %lu, operand %lu)",
 		     (unsigned long) attr_arg_num, (unsigned long) arg_num);
 	      *no_add_attrs = true;
 	      return NULL_TREE;
@@ -5092,7 +5091,8 @@ handle_nonnull_attribute (tree *node, tree ARG_UNUSED (name),
 
 	  if (TREE_CODE (TREE_VALUE (argument)) != POINTER_TYPE)
 	    {
-	      error ("nonnull argument references non-pointer operand (argument %lu, operand %lu)",
+	      error ("nonnull argument references non-pointer operand "
+		     "(argument %lu, operand %lu)",
 		   (unsigned long) attr_arg_num, (unsigned long) arg_num);
 	      *no_add_attrs = true;
 	      return NULL_TREE;

gcc/ada/gcc-interface/utils2.c

@@ -2121,7 +2121,8 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
 					     convert (long_integer_type_node,
 						      addr64expr),
 					     malloc64low),
-			    build_call_raise (CE_Range_Check_Failed, gnat_actual,
+			    build_call_raise (CE_Range_Check_Failed,
+					      gnat_actual,
 					      N_Raise_Constraint_Error),
 			    NULL_TREE));
         }
@@ -2228,9 +2229,12 @@ gnat_protect_expr (tree exp)
      unshared for gimplification; in order to avoid a complexity explosion
      at that point, we protect any expressions more complex than a simple
      arithmetic expression.  */
-  if (!TREE_SIDE_EFFECTS (exp)
-      && !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp)))
-    return exp;
+  if (!TREE_SIDE_EFFECTS (exp))
+    {
+      tree inner = skip_simple_arithmetic (exp);
+      if (!EXPR_P (inner) || REFERENCE_CLASS_P (inner))
+	return exp;
+    }
 
   /* If this is a conversion, protect what's inside the conversion.  */
   if (code == NON_LVALUE_EXPR