This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix crash on x86-64
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 12 Jun 2008 15:22:32 +0200
- Subject: [Ada] Fix crash on x86-64
The underlying problem has been there since day #1 and it is exposed here on
x86-64 for some very specific record layout:
type IArr is Array (Natural range <>) of Integer;
type CArr is Array (Natural range <>) of Character;
type Var_R (D1 : Boolean; D2 : Boolean) is record
case D1 is
when True =>
L : IArr (1..4);
M1, M2 : CArr (1..16);
when False =>
null;
end case;
end record;
type R (D1 : Boolean; D2 : Boolean) is record
Field : Var_R (D1, D2);
end record;
procedure Proc (From : in R; To : out R) is
begin
To := R'(D1 => False, D2 => From.D2, Field => From.Field);
end;
[subtype p__proc__T7b is p__r (false, from.d2)]
The Itype built for the type of Field in p__proc__T7b is translated into a
record type with incorrect layout: it contains the L, M1, M2 fields and they
are beyond its limits. This confuses the code implementing the x86-64 ABI
which is trying to determine how to pass this record type to functions.
This comes from the way Gigi builds this constrained Itype: it doesn't really
lay it out but instead follows the Entity chain and derives the new position
of the component from that of the corresponding component in the original
type Var_R. Clearly that's a bit gross since this will result in overlapping
components coming from different variants or components beyond the limits of
the type, like in the case at hand. But the front-end doesn't compute this
information directly at the moment so it would probably be up to Gigi to do
something on its own.
In the meantime the attached patch simply discards fields that are beyond the
limits of the type. Tested on i586-suse-linux, applied on the mainline.
2008-06-12 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: In the case of a
constrained subtype of a discriminated type, discard the fields that
are beyond its limits according to its size.
2008-06-12 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr9.ad[sb]: New test.
--
Eric Botcazou
Index: decl.c
===================================================================
--- decl.c (revision 136584)
+++ decl.c (working copy)
@@ -2922,9 +2922,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id;
- TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
+ /* Set the size, alignment and alias set of the new type to
+ match that of the old one, doing required substitutions.
+ We do it this early because we need the size of the new
+ type below to discard old fields if necessary. */
+ TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
+ TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
+ SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
+ TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
+ copy_alias_set (gnu_type, gnu_base_type);
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+ for (gnu_temp = gnu_subst_list;
+ gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
+ TYPE_SIZE (gnu_type)
+ = substitute_in_expr (TYPE_SIZE (gnu_type),
+ TREE_PURPOSE (gnu_temp),
+ TREE_VALUE (gnu_temp));
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type)))
+ for (gnu_temp = gnu_subst_list;
+ gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
+ TYPE_SIZE_UNIT (gnu_type)
+ = substitute_in_expr (TYPE_SIZE_UNIT (gnu_type),
+ TREE_PURPOSE (gnu_temp),
+ TREE_VALUE (gnu_temp));
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
+ for (gnu_temp = gnu_subst_list;
+ gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
+ SET_TYPE_ADA_SIZE
+ (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
+ TREE_PURPOSE (gnu_temp),
+ TREE_VALUE (gnu_temp)));
+
for (gnat_field = First_Entity (gnat_entity);
Present (gnat_field); gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component
@@ -2946,7 +2979,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
tree gnu_field_type
= gnat_to_gnu_type (Etype (gnat_field));
tree gnu_size = TYPE_SIZE (gnu_field_type);
- tree gnu_new_pos = 0;
+ tree gnu_new_pos = NULL_TREE;
unsigned int offset_align
= tree_low_cst (TREE_PURPOSE (TREE_VALUE (gnu_offset)),
1);
@@ -2992,11 +3025,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
- /* If the size is now a constant, we can set it as the
- size of the field when we make it. Otherwise, we need
- to deal with it specially. */
+ /* If the position is now a constant, we can set it as the
+ position of the field when we make it. Otherwise, we need
+ to deal with it specially below. */
if (TREE_CONSTANT (gnu_pos))
- gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
+ {
+ gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
+
+ /* Discard old fields that are outside the new type.
+ This avoids confusing code scanning it to decide
+ how to pass it to functions on some platforms. */
+ if (TREE_CODE (gnu_new_pos) == INTEGER_CST
+ && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST
+ && !integer_zerop (gnu_size)
+ && !tree_int_cst_lt (gnu_new_pos,
+ TYPE_SIZE (gnu_type)))
+ continue;
+ }
gnu_field
= create_field_decl
@@ -3044,49 +3089,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
/* Do not finalize it since we're going to modify it below. */
- finish_record_type (gnu_type, nreverse (gnu_field_list),
- 2, true);
-
- /* Now set the size, alignment and alias set of the new type to
- match that of the old one, doing any substitutions, as
- above. */
- TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
- TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
- TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
- SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
- copy_alias_set (gnu_type, gnu_base_type);
-
- if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
- for (gnu_temp = gnu_subst_list;
- gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
- TYPE_SIZE (gnu_type)
- = substitute_in_expr (TYPE_SIZE (gnu_type),
- TREE_PURPOSE (gnu_temp),
- TREE_VALUE (gnu_temp));
-
- if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type)))
- for (gnu_temp = gnu_subst_list;
- gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
- TYPE_SIZE_UNIT (gnu_type)
- = substitute_in_expr (TYPE_SIZE_UNIT (gnu_type),
- TREE_PURPOSE (gnu_temp),
- TREE_VALUE (gnu_temp));
-
- if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
- for (gnu_temp = gnu_subst_list;
- gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
- SET_TYPE_ADA_SIZE
- (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
- TREE_PURPOSE (gnu_temp),
- TREE_VALUE (gnu_temp)));
+ gnu_field_list = nreverse (gnu_field_list);
+ finish_record_type (gnu_type, gnu_field_list, 2, true);
- /* Reapply variable_size since we have changed the sizes. */
+ /* Finalize size and mode. */
TYPE_SIZE (gnu_type) = variable_size (TYPE_SIZE (gnu_type));
TYPE_SIZE_UNIT (gnu_type)
= variable_size (TYPE_SIZE_UNIT (gnu_type));
- /* Recompute the mode of this record type now that we know its
- actual size. */
compute_record_mode (gnu_type);
/* Fill in locations of fields. */
package Discr9 is
type IArr is Array (Natural range <>) of Integer;
type CArr is Array (Natural range <>) of Character;
type Var_R (D1 : Boolean; D2 : Boolean) is record
case D1 is
when True =>
L : IArr (1..4);
M1, M2 : CArr (1..16);
when False =>
null;
end case;
end record;
type R (D1 : Boolean; D2 : Boolean) is record
Field : Var_R (D1, D2);
end record;
procedure Proc (From : in R; To : out R);
end Discr9;
-- { dg-do compile }
package body Discr9 is
procedure Proc (From : in R; To : out R) is
begin
To := R'(D1 => False, D2 => From.D2, Field => From.Field);
end;
end Discr9;