ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed.
* ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed. * decl.c (gnat_to_gnu_entity): Adjust for above change. <E_Record_Type>: Try to get a better form of the component for packing, even if it has an integral mode. <E_Record_Subtype>: Likewise. * trans.c (gnat_to_gnu): Do not require BLKmode for the special exception suppressing the final conversion between record types. Co-Authored-By: Richard Kenner <kenner@adacore.com> From-SVN: r134093
This commit is contained in:
parent
ba3f46d091
commit
2b3dffa66b
|
@ -1,3 +1,14 @@
|
|||
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||
Richard Kenner <kenner@adacore.com>
|
||||
|
||||
* ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed.
|
||||
* decl.c (gnat_to_gnu_entity): Adjust for above change.
|
||||
<E_Record_Type>: Try to get a better form of the component for
|
||||
packing, even if it has an integral mode.
|
||||
<E_Record_Subtype>: Likewise.
|
||||
* trans.c (gnat_to_gnu): Do not require BLKmode for the special
|
||||
exception suppressing the final conversion between record types.
|
||||
|
||||
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* decl.c (gnat_to_gnu_entity) <object>: If -gnatd.a and not optimizing
|
||||
|
|
|
@ -69,8 +69,9 @@ struct lang_type GTY(()) {tree t; };
|
|||
#define TYPE_FAT_POINTER_P(NODE) \
|
||||
(TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_FAT_POINTER_P (NODE))
|
||||
|
||||
/* For integral types and array types, nonzero if this is a packed array type.
|
||||
Such types should not be extended to a larger size. */
|
||||
/* For integral types and array types, nonzero if this is a packed array type
|
||||
used for bit-packed types. Such types should not be extended to a larger
|
||||
size or validated against a specified size. */
|
||||
#define TYPE_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
|
||||
|
||||
#define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \
|
||||
|
|
|
@ -1400,7 +1400,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
|
||||
gnu_type = make_unsigned_type (GET_MODE_BITSIZE (mode));
|
||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
|
||||
= Is_Packed_Array_Type (gnat_entity);
|
||||
= (Is_Packed_Array_Type (gnat_entity)
|
||||
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
|
||||
|
||||
/* Get the modulus in this type. If it overflows, assume it is because
|
||||
it is equal to 2**Esize. Note that there is no overflow checking
|
||||
|
@ -1435,7 +1436,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
TYPE_UNSIGNED (gnu_subtype) = 1;
|
||||
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_subtype)
|
||||
= Is_Packed_Array_Type (gnat_entity);
|
||||
= (Is_Packed_Array_Type (gnat_entity)
|
||||
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
|
||||
layout_type (gnu_subtype);
|
||||
|
||||
gnu_type = gnu_subtype;
|
||||
|
@ -1473,7 +1475,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
gnu_expr, 0);
|
||||
|
||||
gnu_type = make_node (INTEGER_TYPE);
|
||||
if (Is_Packed_Array_Type (gnat_entity))
|
||||
if (Is_Packed_Array_Type (gnat_entity)
|
||||
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
|
||||
{
|
||||
esize = UI_To_Int (RM_Size (gnat_entity));
|
||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
|
||||
|
@ -1531,7 +1534,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
such values), we only get the good bits, since the unused bits
|
||||
are uninitialized. Both goals are accomplished by wrapping the
|
||||
modular value in an enclosing struct. */
|
||||
if (Is_Packed_Array_Type (gnat_entity))
|
||||
if (Is_Packed_Array_Type (gnat_entity)
|
||||
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
|
||||
{
|
||||
tree gnu_field_type = gnu_type;
|
||||
tree gnu_field;
|
||||
|
@ -1839,7 +1843,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
&& !Has_Aliased_Components (gnat_entity)
|
||||
&& !Strict_Alignment (Component_Type (gnat_entity))
|
||||
&& TREE_CODE (tem) == RECORD_TYPE
|
||||
&& TYPE_MODE (tem) == BLKmode
|
||||
&& host_integerp (TYPE_SIZE (tem), 1))
|
||||
tem = make_packable_type (tem, false);
|
||||
|
||||
|
@ -2208,7 +2211,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
&& !Has_Aliased_Components (gnat_entity)
|
||||
&& !Strict_Alignment (Component_Type (gnat_entity))
|
||||
&& TREE_CODE (gnu_type) == RECORD_TYPE
|
||||
&& TYPE_MODE (gnu_type) == BLKmode
|
||||
&& host_integerp (TYPE_SIZE (gnu_type), 1))
|
||||
gnu_type = make_packable_type (gnu_type, false);
|
||||
|
||||
|
@ -2341,7 +2343,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
TYPE_CONVENTION_FORTRAN_P (gnu_type)
|
||||
= (Convention (gnat_entity) == Convention_Fortran);
|
||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
|
||||
= Is_Packed_Array_Type (gnat_entity);
|
||||
= (Is_Packed_Array_Type (gnat_entity)
|
||||
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
|
||||
|
||||
/* If our size depends on a placeholder and the maximum size doesn't
|
||||
overflow, use it. */
|
||||
|
@ -5400,12 +5403,12 @@ round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
|
|||
return t;
|
||||
}
|
||||
|
||||
/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode that
|
||||
is being used as the field type of a packed record if IN_RECORD is true,
|
||||
or as the component type of a packed array if IN_RECORD is false. See
|
||||
if we can rewrite it either as a type that has a non-BLKmode, which we
|
||||
can pack tighter, or as a smaller type with BLKmode. If so, return the
|
||||
new type. If not, return the original type. */
|
||||
/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
|
||||
as the field type of a packed record if IN_RECORD is true, or as the
|
||||
component type of a packed array if IN_RECORD is false. See if we can
|
||||
rewrite it either as a type that has a non-BLKmode, which we can pack
|
||||
tighter in the packed record case, or as a smaller type with BLKmode.
|
||||
If so, return the new type. If not, return the original type. */
|
||||
|
||||
static tree
|
||||
make_packable_type (tree type, bool in_record)
|
||||
|
|
|
@ -4848,10 +4848,10 @@ gnat_to_gnu (Node_Id gnat_node)
|
|||
its size since those are the cases where the front end may have the
|
||||
type wrong due to "instantiating" the unconstrained record with
|
||||
discriminant values. Similarly, if the two types are record types
|
||||
with the same name and the result type has BLKmode, don't convert.
|
||||
This will be the case when we are converting from a packed version
|
||||
of a type to its original type and we need those conversions to be
|
||||
NOPs in order for assignments into these types to work properly.
|
||||
with the same name don't convert. This will be the case when we are
|
||||
converting from a packed version of a type to its original type and
|
||||
we need those conversions to be NOPs in order for assignments into
|
||||
these types to work properly.
|
||||
|
||||
3. If the type is void or if we have no result, return error_mark_node
|
||||
to show we have no result.
|
||||
|
@ -4903,8 +4903,7 @@ gnat_to_gnu (Node_Id gnat_node)
|
|||
|| ((TYPE_NAME (gnu_result_type)
|
||||
== TYPE_NAME (TREE_TYPE (gnu_result)))
|
||||
&& TREE_CODE (gnu_result_type) == RECORD_TYPE
|
||||
&& TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
|
||||
&& TYPE_MODE (gnu_result_type) == BLKmode))
|
||||
&& TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE))
|
||||
{
|
||||
/* Remove any padding. */
|
||||
if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/pack6.adb: New test.
|
||||
* gnat.dg/pack7.adb: Likewise.
|
||||
* gnat.dg/pack8.adb: Likewise.
|
||||
|
||||
2008-04-08 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* gnat.dg/parent_ltd_with-child_full_view.adb: New test.
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
-- { dg-do compile }
|
||||
-- { dg-options "-gnatws" }
|
||||
|
||||
procedure Pack6 is
|
||||
|
||||
type R is record
|
||||
I : Integer;
|
||||
a, b, c, d, e : Character;
|
||||
end record;
|
||||
|
||||
type Ar1 is array (1..4) of R;
|
||||
type Ar2 is array (1..4) of R;
|
||||
pragma Pack (Ar2);
|
||||
|
||||
type R2 is record
|
||||
A : Ar2;
|
||||
end record;
|
||||
for R2 use record
|
||||
A at 0 range 0 .. 72*4-1;
|
||||
end record;
|
||||
|
||||
X : Ar1;
|
||||
Y : Ar2;
|
||||
|
||||
begin
|
||||
Y (1) := X (1);
|
||||
end;
|
|
@ -0,0 +1,27 @@
|
|||
-- { dg-do compile }
|
||||
-- { dg-options "-gnatws" }
|
||||
|
||||
procedure Pack7 is
|
||||
|
||||
type R is record
|
||||
I : Integer;
|
||||
a, b : Character;
|
||||
end record;
|
||||
|
||||
type Ar1 is array (1..4) of R;
|
||||
type Ar2 is array (1..4) of R;
|
||||
pragma Pack (Ar2);
|
||||
|
||||
type R2 is record
|
||||
A : Ar2;
|
||||
end record;
|
||||
for R2 use record
|
||||
A at 0 range 0 .. 48*4-1;
|
||||
end record;
|
||||
|
||||
X : Ar1;
|
||||
Y : Ar2;
|
||||
|
||||
begin
|
||||
Y (1) := X (1);
|
||||
end;
|
|
@ -0,0 +1,27 @@
|
|||
-- { dg-do compile }
|
||||
-- { dg-options "-gnatws" }
|
||||
|
||||
procedure Pack8 is
|
||||
|
||||
type R is record
|
||||
I : Integer;
|
||||
a, b : Character;
|
||||
end record;
|
||||
|
||||
type Ar1 is array (1..4) of R;
|
||||
type Ar2 is array (1..4) of R;
|
||||
pragma Pack (Ar2);
|
||||
|
||||
type R2 is record
|
||||
A : Ar2;
|
||||
end record;
|
||||
for R2 use record
|
||||
A at 0 range 0 .. 48*4-1-1; -- { dg-error "too small" }
|
||||
end record;
|
||||
|
||||
X : Ar1;
|
||||
Y : Ar2;
|
||||
|
||||
begin
|
||||
Y (1) := X (1);
|
||||
end;
|
Loading…
Reference in New Issue