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>
|
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* decl.c (gnat_to_gnu_entity) <object>: If -gnatd.a and not optimizing
|
* 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) \
|
#define TYPE_FAT_POINTER_P(NODE) \
|
||||||
(TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_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.
|
/* For integral types and array types, nonzero if this is a packed array type
|
||||||
Such types should not be extended to a larger size. */
|
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_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
|
||||||
|
|
||||||
#define TYPE_IS_PACKED_ARRAY_TYPE_P(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));
|
gnu_type = make_unsigned_type (GET_MODE_BITSIZE (mode));
|
||||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
|
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
|
/* 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
|
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_UNSIGNED (gnu_subtype) = 1;
|
||||||
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
||||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_subtype)
|
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);
|
layout_type (gnu_subtype);
|
||||||
|
|
||||||
gnu_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_expr, 0);
|
||||||
|
|
||||||
gnu_type = make_node (INTEGER_TYPE);
|
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));
|
esize = UI_To_Int (RM_Size (gnat_entity));
|
||||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
|
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
|
such values), we only get the good bits, since the unused bits
|
||||||
are uninitialized. Both goals are accomplished by wrapping the
|
are uninitialized. Both goals are accomplished by wrapping the
|
||||||
modular value in an enclosing struct. */
|
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_type = gnu_type;
|
||||||
tree gnu_field;
|
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)
|
&& !Has_Aliased_Components (gnat_entity)
|
||||||
&& !Strict_Alignment (Component_Type (gnat_entity))
|
&& !Strict_Alignment (Component_Type (gnat_entity))
|
||||||
&& TREE_CODE (tem) == RECORD_TYPE
|
&& TREE_CODE (tem) == RECORD_TYPE
|
||||||
&& TYPE_MODE (tem) == BLKmode
|
|
||||||
&& host_integerp (TYPE_SIZE (tem), 1))
|
&& host_integerp (TYPE_SIZE (tem), 1))
|
||||||
tem = make_packable_type (tem, false);
|
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)
|
&& !Has_Aliased_Components (gnat_entity)
|
||||||
&& !Strict_Alignment (Component_Type (gnat_entity))
|
&& !Strict_Alignment (Component_Type (gnat_entity))
|
||||||
&& TREE_CODE (gnu_type) == RECORD_TYPE
|
&& TREE_CODE (gnu_type) == RECORD_TYPE
|
||||||
&& TYPE_MODE (gnu_type) == BLKmode
|
|
||||||
&& host_integerp (TYPE_SIZE (gnu_type), 1))
|
&& host_integerp (TYPE_SIZE (gnu_type), 1))
|
||||||
gnu_type = make_packable_type (gnu_type, false);
|
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)
|
TYPE_CONVENTION_FORTRAN_P (gnu_type)
|
||||||
= (Convention (gnat_entity) == Convention_Fortran);
|
= (Convention (gnat_entity) == Convention_Fortran);
|
||||||
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
|
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
|
/* If our size depends on a placeholder and the maximum size doesn't
|
||||||
overflow, use it. */
|
overflow, use it. */
|
||||||
|
@ -5400,12 +5403,12 @@ round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
|
||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode that
|
/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
|
||||||
is being used as the field type of a packed record if IN_RECORD is true,
|
as the field type of a packed record if IN_RECORD is true, or as the
|
||||||
or as the component type of a packed array if IN_RECORD is false. See
|
component type of a packed array if IN_RECORD is false. See if we can
|
||||||
if we can rewrite it either as a type that has a non-BLKmode, which we
|
rewrite it either as a type that has a non-BLKmode, which we can pack
|
||||||
can pack tighter, or as a smaller type with BLKmode. If so, return the
|
tighter in the packed record case, or as a smaller type with BLKmode.
|
||||||
new type. If not, return the original type. */
|
If so, return the new type. If not, return the original type. */
|
||||||
|
|
||||||
static tree
|
static tree
|
||||||
make_packable_type (tree type, bool in_record)
|
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
|
its size since those are the cases where the front end may have the
|
||||||
type wrong due to "instantiating" the unconstrained record with
|
type wrong due to "instantiating" the unconstrained record with
|
||||||
discriminant values. Similarly, if the two types are record types
|
discriminant values. Similarly, if the two types are record types
|
||||||
with the same name and the result type has BLKmode, don't convert.
|
with the same name don't convert. This will be the case when we are
|
||||||
This will be the case when we are converting from a packed version
|
converting from a packed version of a type to its original type and
|
||||||
of a type to its original type and we need those conversions to be
|
we need those conversions to be NOPs in order for assignments into
|
||||||
NOPs in order for assignments into these types to work properly.
|
these types to work properly.
|
||||||
|
|
||||||
3. If the type is void or if we have no result, return error_mark_node
|
3. If the type is void or if we have no result, return error_mark_node
|
||||||
to show we have no result.
|
to show we have no result.
|
||||||
|
@ -4903,8 +4903,7 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||||
|| ((TYPE_NAME (gnu_result_type)
|
|| ((TYPE_NAME (gnu_result_type)
|
||||||
== TYPE_NAME (TREE_TYPE (gnu_result)))
|
== TYPE_NAME (TREE_TYPE (gnu_result)))
|
||||||
&& TREE_CODE (gnu_result_type) == RECORD_TYPE
|
&& TREE_CODE (gnu_result_type) == RECORD_TYPE
|
||||||
&& TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
|
&& TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE))
|
||||||
&& TYPE_MODE (gnu_result_type) == BLKmode))
|
|
||||||
{
|
{
|
||||||
/* Remove any padding. */
|
/* Remove any padding. */
|
||||||
if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
|
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>
|
2008-04-08 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
* gnat.dg/parent_ltd_with-child_full_view.adb: New test.
|
* 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