This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix bugs with volatile and components of aggregate types
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 18 Jun 2011 12:55:09 +0200
- Subject: [Ada] Fix bugs with volatile and components of aggregate types
This is the usual problem of volatile accesses not preserved under (heavy)
optimization. In Ada, we can put pragma Volatile on components of composite
types without putting it on the enclosing type itself, but this doesn't really
work when you're starting to optimize.
Mostly gigi changes, but this plugs a hole in type_internals_preclude_sra_p
which already tests TREE_THIS_VOLATILE on fields of record and union types but
doesn't perform the equivalent test for array types.
Tested on i586-suse-linux, applied on mainline, as obvious for the SRA bits.
2011-06-18 Eric Botcazou <ebotcazou@adacore.com>
* tree-sra.c (type_internals_preclude_sra_p) <ARRAY_TYPE>: Return true
if the element type is volatile.
ada/
* gcc-interface/decl.c (gnat_to_gnu_component_type): Use GNAT_TYPE
local variable throughout. Remove useless call to Base_Type.
(gnat_to_gnu_field): Use GNAT_FIELD_TYPE local variable throughout.
Take it also into account for the volatileness of the field. Set the
TREE_SIDE_EFFECTS flag as well in this case. Reorder some warnings.
2011-06-18 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/volatile6.adb: New test.
* gnat.dg/volatile7.adb: Likewise.
* gnat.dg/volatile8.adb: Likewise.
* gnat.dg/volatile9.adb: Likewise.
--
Eric Botcazou
Index: ada/gcc-interface/decl.c
===================================================================
--- ada/gcc-interface/decl.c (revision 175136)
+++ ada/gcc-interface/decl.c (working copy)
@@ -5229,7 +5229,8 @@ static tree
gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
bool debug_info_p)
{
- tree gnu_type = gnat_to_gnu_type (Component_Type (gnat_array));
+ const Entity_Id gnat_type = Component_Type (gnat_array);
+ tree gnu_type = gnat_to_gnu_type (gnat_type);
tree gnu_comp_size;
/* Try to get a smaller form of the component if needed. */
@@ -5237,7 +5238,7 @@ gnat_to_gnu_component_type (Entity_Id gn
|| Has_Component_Size_Clause (gnat_array))
&& !Is_Bit_Packed_Array (gnat_array)
&& !Has_Aliased_Components (gnat_array)
- && !Strict_Alignment (Component_Type (gnat_array))
+ && !Strict_Alignment (gnat_type)
&& TREE_CODE (gnu_type) == RECORD_TYPE
&& !TYPE_FAT_POINTER_P (gnu_type)
&& host_integerp (TYPE_SIZE (gnu_type), 1))
@@ -5301,7 +5302,7 @@ gnat_to_gnu_component_type (Entity_Id gn
debug_info_p, gnat_array);
}
- if (Has_Volatile_Components (Base_Type (gnat_array)))
+ if (Has_Volatile_Components (gnat_array))
gnu_type
= build_qualified_type (gnu_type,
TYPE_QUALS (gnu_type) | TYPE_QUAL_VOLATILE);
@@ -6716,12 +6717,16 @@ static tree
gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
bool definition, bool debug_info_p)
{
+ const Entity_Id gnat_field_type = Etype (gnat_field);
+ tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
tree gnu_field_id = get_entity_name (gnat_field);
- tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
tree gnu_field, gnu_size, gnu_pos;
+ bool is_volatile
+ = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
bool needs_strict_alignment
- = (Is_Aliased (gnat_field) || Strict_Alignment (Etype (gnat_field))
- || Treat_As_Volatile (gnat_field));
+ = (is_volatile
+ || Is_Aliased (gnat_field)
+ || Strict_Alignment (gnat_field_type));
/* If this field requires strict alignment, we cannot pack it because
it would very likely be under-aligned in the record. */
@@ -6737,7 +6742,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true);
else if (packed == 1)
- gnu_size = validate_size (RM_Size (Etype (gnat_field)), gnu_field_type,
+ gnu_size = validate_size (RM_Size (gnat_field_type), gnu_field_type,
gnat_field, FIELD_DECL, false, true);
else
gnu_size = NULL_TREE;
@@ -6829,7 +6834,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
if (gnu_size
&& !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
{
- if (Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field)))
+ if (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type))
post_error_ne_tree
("atomic field& must be natural size of type{ (^)}",
Last_Bit (Component_Clause (gnat_field)), gnat_field,
@@ -6841,7 +6846,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
Last_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_SIZE (gnu_field_type));
- else if (Strict_Alignment (Etype (gnat_field)))
+ else if (Strict_Alignment (gnat_field_type))
post_error_ne_tree
("size of & with aliased or tagged components not ^ bits",
Last_Bit (Component_Clause (gnat_field)), gnat_field,
@@ -6854,19 +6859,19 @@ gnat_to_gnu_field (Entity_Id gnat_field,
(TRUNC_MOD_EXPR, gnu_pos,
bitsize_int (TYPE_ALIGN (gnu_field_type)))))
{
- if (Is_Aliased (gnat_field))
+ if (is_volatile)
post_error_ne_num
- ("position of aliased field& must be multiple of ^ bits",
+ ("position of volatile field& must be multiple of ^ bits",
First_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_ALIGN (gnu_field_type));
- else if (Treat_As_Volatile (gnat_field))
+ else if (Is_Aliased (gnat_field))
post_error_ne_num
- ("position of volatile field& must be multiple of ^ bits",
+ ("position of aliased field& must be multiple of ^ bits",
First_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_ALIGN (gnu_field_type));
- else if (Strict_Alignment (Etype (gnat_field)))
+ else if (Strict_Alignment (gnat_field_type))
post_error_ne_num
("position of & with aliased or tagged components not multiple of ^ bits",
First_Bit (Component_Clause (gnat_field)), gnat_field,
@@ -6901,7 +6906,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
if (TREE_CODE (gnu_field_type) == RECORD_TYPE
&& !gnu_size
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_field_type))
- && !Is_Constrained (Underlying_Type (Etype (gnat_field))))
+ && !Is_Constrained (Underlying_Type (gnat_field_type)))
{
gnu_size = max_size (TYPE_SIZE (gnu_field_type), true);
packed = 0;
@@ -6953,7 +6958,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
= create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
- TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
+ TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
if (Ekind (gnat_field) == E_Discriminant)
DECL_DISCRIMINANT_NUMBER (gnu_field)
Index: tree-sra.c
===================================================================
--- tree-sra.c (revision 175136)
+++ tree-sra.c (working copy)
@@ -671,8 +671,7 @@ type_internals_preclude_sra_p (tree type
&& int_bit_position (fld) % BITS_PER_UNIT != 0))
return true;
- if (AGGREGATE_TYPE_P (ft)
- && type_internals_preclude_sra_p (ft))
+ if (AGGREGATE_TYPE_P (ft) && type_internals_preclude_sra_p (ft))
return true;
}
@@ -681,10 +680,13 @@ type_internals_preclude_sra_p (tree type
case ARRAY_TYPE:
et = TREE_TYPE (type);
- if (AGGREGATE_TYPE_P (et))
- return type_internals_preclude_sra_p (et);
- else
- return false;
+ if (TYPE_VOLATILE (et))
+ return true;
+
+ if (AGGREGATE_TYPE_P (et) && type_internals_preclude_sra_p (et))
+ return true;
+
+ return false;
default:
return false;
-- { dg-do compile }
-- { dg-options "-O2 -fdump-tree-optimized" }
function Volatile6 return Integer is
type Vol is new Integer;
pragma Volatile (Vol);
V : Vol := 0;
begin
for J in 1 .. 10 loop
V := V + 1;
end loop;
return Integer (V);
end;
-- { dg-final { scan-tree-dump "goto" "optimized" } }
-- { dg-final { cleanup-tree-dump "optimized" } }
-- { dg-do compile }
-- { dg-options "-O2 -fdump-tree-optimized" }
function Volatile7 return Integer is
type Vol is new Integer;
pragma Volatile (Vol);
type R is record
X : Vol := 0;
end record;
V : R;
begin
for J in 1 .. 10 loop
V.X := V.X + 1;
end loop;
return Integer (V.X);
end;
-- { dg-final { scan-tree-dump "goto" "optimized" } }
-- { dg-final { cleanup-tree-dump "optimized" } }
-- { dg-do compile }
-- { dg-options "-O2 -fdump-tree-optimized" }
function Volatile8 return Integer is
type Vol is new Integer;
pragma Volatile (Vol);
type A is array (1..4) of Vol;
V : A := (others => 0);
begin
for J in 1 .. 10 loop
V(1) := V(1) + 1;
end loop;
return Integer (V(1));
end;
-- { dg-final { scan-tree-dump "goto" "optimized" } }
-- { dg-final { cleanup-tree-dump "optimized" } }
-- { dg-do compile }
-- { dg-options "-O2 -fdump-tree-optimized" }
function Volatile9 return Integer is
type A is array (1..4) of Integer;
pragma Volatile_Components (A);
V : A := (others => 0);
begin
for J in 1 .. 10 loop
V(1) := V(1) + 1;
end loop;
return V(1);
end;
-- { dg-final { scan-tree-dump "goto" "optimized" } }
-- { dg-final { cleanup-tree-dump "optimized" } }