This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix and improve record packing (2)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Tue, 8 Apr 2008 14:27:42 +0200
- Subject: [Ada] Fix and improve record packing (2)
This is a follow-up to
http://gcc.gnu.org/ml/gcc-patches/2008-03/msg00482.html
It lifts a technical restriction that was preventing the pragma Pack from
working in a specific case, as well as implements a tightened check to detect
size and component size clauses that cannnot be honored on packed records.
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
Richard Kenner <kenner@adacore.com>
* ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set 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>
* gnat.dg/pack6.adb: New test.
* gnat.dg/pack7.adb: Likewise.
* gnat.dg/pack8.adb: Likewise.
--
Eric Botcazou
Index: ada-tree.h
===================================================================
--- ada-tree.h (revision 134086)
+++ ada-tree.h (working copy)
@@ -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) \
Index: decl.c
===================================================================
--- decl.c (revision 134092)
+++ decl.c (working copy)
@@ -1400,7 +1400,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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_entit
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_entit
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_entit
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_entit
&& !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_entit
&& !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_entit
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_IN
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)
Index: trans.c
===================================================================
--- trans.c (revision 134092)
+++ trans.c (working copy)
@@ -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
-- { 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;
-- { 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;
-- { 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;