gigi.h (create_var_decl): Adjust prototype.

	* gcc-interface/gigi.h (create_var_decl): Adjust prototype.
	(create_subprog_decl): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Rename
	static_p into static_flag and add volatile_flag local variable.
	Do not locally change the type of a volatile object, except for the
	pointed-to type if the object is handled by reference.  Adjust calls
	to create_var_decl.
	<E_Subprogram_Type>: Likewise for const and noreturn subprograms.
	(get_minimal_subprog_decl): Adjust call to create_subprog_decl.
	(elaborate_expression_1): Adjust call to create_var_decl.
	(gnat_to_gnu_field): Minor tweak.
	* gcc-interface/trans.c (gigi): Adjust calls to create_var_decl and
	create_subprog_decl.
	(build_raise_check): Likewise.
	(Subprogram_Body_to_gnu): Likewise.
	(create_temporary): Likewise.
	(Handled_Sequence_Of_Statements_to_gnu): Likewise.
	(Exception_Handler_to_gnu_gcc): Likewise.
	(Compilation_Unit_to_gnu): Likewise.
	(gnat_to_gnu): Likewise.
	* gcc-interface/utils.c (maybe_pad_type): Likewise.
	(create_var_decl): Add VOLATILE_FLAG parameter and handle it.
	(create_subprog_decl): Add CONST_FLAG and VOLATILE_FLAG parameters and
	handle them.

From-SVN: r231065

1 files changed, 64 insertions, 59 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 2450b50..c72e920 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -598,7 +598,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		 || Present (Renamed_Object (gnat_entity))
 		 || imported_p));
 	bool inner_const_flag = const_flag;
-	bool static_p = Is_Statically_Allocated (gnat_entity);
+	bool static_flag = Is_Statically_Allocated (gnat_entity);
+	/* We implement RM 13.3(19) for exported and imported (non-constant)
+	   objects by making them volatile.  */
+	bool volatile_flag
+	  = (Treat_As_Volatile (gnat_entity)
+	     || (!const_flag && (Is_Exported (gnat_entity) || imported_p)));
 	bool mutable_p = false;
 	bool used_by_ref = false;
 	tree gnu_ext_name = NULL_TREE;
@@ -1034,10 +1039,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
 		  gnu_type
 		    = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
-
 		gnu_type = build_reference_type (gnu_type);
 		used_by_ref = true;
 		const_flag = true;
+		volatile_flag = false;
 		inner_const_flag = TREE_READONLY (gnu_expr);
 		gnu_size = NULL_TREE;
 
@@ -1068,21 +1073,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      }
 	  }
 
-	/* Make a volatile version of this object's type if we are to make
-	   the object volatile.  We also implement RM 13.3(19) for exported
-	   and imported (non-constant) objects by making them volatile.  */
-	if ((Treat_As_Volatile (gnat_entity)
-	     || (!const_flag
-		 && gnu_type != except_type_node
-		 && (Is_Exported (gnat_entity) || imported_p)))
-	    && !TYPE_VOLATILE (gnu_type))
-	  {
-	    const int quals
-	      = TYPE_QUAL_VOLATILE
-		| (Is_Atomic_Or_VFA (gnat_entity) ? TYPE_QUAL_ATOMIC : 0);
-	    gnu_type = change_qualified_type (gnu_type, quals);
-	  }
-
 	/* If we are defining an aliased object whose nominal subtype is
 	   unconstrained, the object is a record that contains both the
 	   template and the object.  If there is an initializer, it will
@@ -1142,13 +1132,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	    /* Convert the type of the object to a reference type that can
 	       alias everything as per RM 13.3(19).  */
+	    if (volatile_flag && !TYPE_VOLATILE (gnu_type))
+	      gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
 	    gnu_type
 	      = build_reference_type_for_mode (gnu_type, ptr_mode, true);
 	    gnu_address = convert (gnu_type, gnu_address);
 	    used_by_ref = true;
 	    const_flag
-	      = !Is_Public (gnat_entity)
-		|| compile_time_known_address_p (gnat_expr);
+	      = (!Is_Public (gnat_entity)
+		 || compile_time_known_address_p (gnat_expr));
+	    volatile_flag = false;
 	    gnu_size = NULL_TREE;
 
 	    /* If this is an aliased object with an unconstrained array nominal
@@ -1210,9 +1203,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  {
 	    /* Convert the type of the object to a reference type that can
 	       alias everything as per RM 13.3(19).  */
+	    if (volatile_flag && !TYPE_VOLATILE (gnu_type))
+	      gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
 	    gnu_type
 	      = build_reference_type_for_mode (gnu_type, ptr_mode, true);
 	    used_by_ref = true;
+	    const_flag = false;
+	    volatile_flag = false;
 	    gnu_size = NULL_TREE;
 
 	    /* No point in taking the address of an initializing expression
@@ -1248,7 +1245,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
 				 global_bindings_p ()
 				 || !definition
-				 || static_p)
+				 || static_flag)
 	    || (gnu_size
 		&& !allocatable_size_p (convert (sizetype,
 						 size_binop
@@ -1256,11 +1253,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 						  bitsize_unit_node)),
 					global_bindings_p ()
 					|| !definition
-					|| static_p)))
+					|| static_flag)))
 	  {
+	    if (volatile_flag && !TYPE_VOLATILE (gnu_type))
+	      gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
 	    gnu_type = build_reference_type (gnu_type);
 	    used_by_ref = true;
 	    const_flag = true;
+	    volatile_flag = false;
 	    gnu_size = NULL_TREE;
 
 	    /* In case this was a aliased object whose nominal subtype is
@@ -1314,7 +1314,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   a variable of "aligning type".  */
 	if (definition
 	    && !global_bindings_p ()
-	    && !static_p
+	    && !static_flag
 	    && !imported_p
 	    && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
 	  {
@@ -1326,9 +1326,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				    BIGGEST_ALIGNMENT, 0, gnat_entity);
 	    tree gnu_new_var
 	      = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
-				 NULL_TREE, gnu_new_type, NULL_TREE, false,
-				 false, false, false, true, debug_info_p,
-				 NULL, gnat_entity);
+				 NULL_TREE, gnu_new_type, NULL_TREE,
+				 false, false, false, false, false,
+				 true, debug_info_p, NULL, gnat_entity);
 
 	    /* Initialize the aligned field if we have an initializer.  */
 	    if (gnu_expr)
@@ -1351,6 +1351,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	    used_by_ref = true;
 	    const_flag = true;
+	    volatile_flag = false;
 	    gnu_size = NULL_TREE;
 	  }
 
@@ -1375,13 +1376,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		   = create_var_decl (concat_name (gnu_entity_name, "UNC"),
 				      NULL_TREE, gnu_type, gnu_expr,
 				      const_flag, Is_Public (gnat_entity),
-				      imported_p || !definition, static_p,
-				      true, debug_info_p, NULL, gnat_entity);
+				      imported_p || !definition, static_flag,
+				      volatile_flag, true, debug_info_p,
+				      NULL, gnat_entity);
 		gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
 		TREE_CONSTANT (gnu_expr) = 1;
 
 		used_by_ref = true;
 		const_flag = true;
+		volatile_flag = false;
 		inner_const_flag = TREE_READONLY (gnu_unc_var);
 		gnu_size = NULL_TREE;
 	      }
@@ -1408,7 +1411,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	/* If this is an aggregate constant initialized to a constant, force it
 	   to be statically allocated.  This saves an initialization copy.  */
-	if (!static_p
+	if (!static_flag
 	    && const_flag
 	    && gnu_expr && TREE_CONSTANT (gnu_expr)
 	    && AGGREGATE_TYPE_P (gnu_type)
@@ -1416,7 +1419,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    && !(TYPE_IS_PADDING_P (gnu_type)
 		 && !tree_fits_uhwi_p (TYPE_SIZE_UNIT
 				       (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
-	  static_p = true;
+	  static_flag = true;
 
 	/* Deal with a pragma Linker_Section on a constant or variable.  */
 	if ((kind == E_Constant || kind == E_Variable)
@@ -1428,9 +1431,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	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,
-			     artificial_p, debug_info_p, attr_list,
-			     gnat_entity, !renamed_obj);
+			     imported_p || !definition, static_flag,
+			     volatile_flag, artificial_p, debug_info_p,
+			     attr_list, gnat_entity, !renamed_obj);
 	DECL_BY_REF_P (gnu_decl) = used_by_ref;
 	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
 	DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity);
@@ -1481,9 +1484,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    tree gnu_corr_var
 	      = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
 				 gnu_expr, true, Is_Public (gnat_entity),
-				 !definition, static_p, artificial_p,
-				 debug_info_p, attr_list, gnat_entity,
-				 false);
+				 !definition, static_flag, volatile_flag,
+				 artificial_p, debug_info_p, attr_list,
+				 gnat_entity, false);
 
 	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
 	  }
@@ -1599,8 +1602,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      tree gnu_literal
 		= create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
 				   gnu_type, gnu_value, true, false, false,
-				   false, !Comes_From_Source (gnat_literal),
-				   false, NULL, gnat_literal);
+				   false, false, artificial_p, false,
+				   NULL, gnat_literal);
 	      save_gnu_tree (gnat_literal, gnu_literal, false);
 	      gnu_list
 	        = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_list);
@@ -3583,8 +3586,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		      = create_var_decl (create_concat_name (gnat_entity,
 							     "XVZ"),
 					 NULL_TREE, sizetype, gnu_size_unit,
-					 false, false, false, false, true,
-					 debug_info_p, NULL, gnat_entity);
+					 false, false, false, false, false,
+					 true, debug_info_p,
+					 NULL, gnat_entity);
 		}
 
 	      gnu_variant_list.release ();
@@ -4090,10 +4094,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           Ada subprograms that can throw have side effects since they can
           trigger an "abnormal" transfer of control flow; thus they can be
           neither "const" nor "pure" in the back-end sense.  */
-	bool const_flag
-	  = (Back_End_Exceptions ()
-	     && Is_Pure (gnat_entity));
-	bool noreturn_flag = No_Return (gnat_entity);
+	bool const_flag = (Back_End_Exceptions () && Is_Pure (gnat_entity));
+	bool volatile_flag = No_Return (gnat_entity);
 	bool return_by_direct_ref_p = false;
 	bool return_by_invisi_ref_p = false;
 	bool return_unconstrained_p = false;
@@ -4552,14 +4554,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (TREE_CODE (gnu_return_type) == VOID_TYPE || return_unconstrained_p)
 	  const_flag = false;
 
-	if (const_flag || noreturn_flag)
-	  {
-	    const int quals
-	      = (const_flag ? TYPE_QUAL_CONST : 0)
-		| (noreturn_flag ? TYPE_QUAL_VOLATILE : 0);
-	    gnu_type = change_qualified_type (gnu_type, quals);
-	  }
-
 	/* If we have a builtin decl for that function, use it.  Check if the
 	   profiles are compatible and warn if they are not.  The checker is
 	   expected to post extra diagnostics in this case.  */
@@ -4617,7 +4611,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    gnu_decl
 	      = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
 				 gnu_address, false, Is_Public (gnat_entity),
-				 extern_flag, false, artificial_p,
+				 extern_flag, false, false, artificial_p,
 				 debug_info_p, NULL, gnat_entity);
 	    DECL_BY_REF_P (gnu_decl) = 1;
 	  }
@@ -4625,6 +4619,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	else if (kind == E_Subprogram_Type)
 	  {
 	    process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+
+	    if (const_flag || volatile_flag)
+	      {
+		const int quals
+		  = (const_flag ? TYPE_QUAL_CONST : 0)
+		     | (volatile_flag ? TYPE_QUAL_VOLATILE : 0);
+		gnu_type = change_qualified_type (gnu_type, quals);
+	      }
+
 	    gnu_decl
 	      = create_type_decl (gnu_entity_name, gnu_type, artificial_p,
 				  debug_info_p, gnat_entity);
@@ -4633,9 +4636,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  {
 	    gnu_decl
 	      = create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type,
-				     gnu_param_list, inline_status,
-				     public_flag, extern_flag, artificial_p,
-				     debug_info_p, attr_list, gnat_entity);
+				     gnu_param_list, inline_status, const_flag,
+				     public_flag, extern_flag, volatile_flag,
+				     artificial_p, debug_info_p,
+				     attr_list, gnat_entity);
 	    /* This is unrelated to the stub built right above.  */
 	    DECL_STUBBED_P (gnu_decl)
 	      = Convention (gnat_entity) == Convention_Stubbed;
@@ -5418,8 +5422,8 @@ get_minimal_subprog_decl (Entity_Id gnat_entity)
 
   return
     create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
-			 is_disabled, true, true, true, false, attr_list,
-			 gnat_entity);
+			 is_disabled, false, true, true, false, true, false,
+			 attr_list, gnat_entity);
 }
 
 /* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
@@ -6311,7 +6315,8 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
 	= create_var_decl (create_concat_name (gnat_entity, s), NULL_TREE,
 			   TREE_TYPE (gnu_expr), gnu_expr, true,
 			   expr_public_p, !definition && expr_global_p,
-			   expr_global_p, true, need_debug, NULL, gnat_entity);
+			   expr_global_p, false, true, need_debug,
+			   NULL, gnat_entity);
 
       /* Using this variable at debug time (if need_debug is true) requires a
 	 proper location.  The back-end will compute a location for this
@@ -6824,7 +6829,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 			 gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
   Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
   DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field);
-  TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
+  TREE_SIDE_EFFECTS (gnu_field) = TREE_THIS_VOLATILE (gnu_field) = is_volatile;
 
   if (Ekind (gnat_field) == E_Discriminant)
     {