From b1fa9126ab0782c68bd92431a7bb93de0931fc3d Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed, 7 Apr 2010 11:38:06 +0000
Subject: [PATCH] exp_pakd.adb (Create_Packed_Array_Type): Always use a modular
type if the size is small enough.
* exp_pakd.adb (Create_Packed_Array_Type): Always use a modular type
if the size is small enough. Propagate the alignment if there is an
alignment clause on the original array type.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Subtype>
Deal with under-aligned packed array types. Copy the size onto the
justified modular type and don't lay it out again. Likewise for the
padding type built for other under-aligned subtypes.
* gcc-interface/utils.c (finish_record_type): Do not set a default mode
on the type.
From-SVN: r158056
---
gcc/ada/ChangeLog | 12 +++
gcc/ada/exp_pakd.adb | 18 ++--
gcc/ada/gcc-interface/decl.c | 87 +++++++++++--------
gcc/ada/gcc-interface/utils.c | 2 +-
gcc/testsuite/ChangeLog | 6 ++
...packed_array.adb => bit_packed_array1.adb} | 4 +-
...packed_array.ads => bit_packed_array1.ads} | 7 +-
gcc/testsuite/gnat.dg/bit_packed_array4.adb | 11 +++
gcc/testsuite/gnat.dg/bit_packed_array4.ads | 18 ++++
9 files changed, 114 insertions(+), 51 deletions(-)
rename gcc/testsuite/gnat.dg/{bit_packed_array.adb => bit_packed_array1.adb} (84%)
rename gcc/testsuite/gnat.dg/{bit_packed_array.ads => bit_packed_array1.ads} (85%)
create mode 100644 gcc/testsuite/gnat.dg/bit_packed_array4.adb
create mode 100644 gcc/testsuite/gnat.dg/bit_packed_array4.ads
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 09469ac839bd..c740fa82c20e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2010-04-07 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_pakd.adb (Create_Packed_Array_Type): Always use a modular type
+ if the size is small enough. Propagate the alignment if there is an
+ alignment clause on the original array type.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Subtype>
+ Deal with under-aligned packed array types. Copy the size onto the
+ justified modular type and don't lay it out again. Likewise for the
+ padding type built for other under-aligned subtypes.
+ * gcc-interface/utils.c (finish_record_type): Do not set a default mode
+ on the type.
+
2010-04-07 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Procedure>: Set default
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index ed7ac4b9e76f..c1d25c2d68f1 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -1134,16 +1134,6 @@ package body Exp_Pakd is
(Len_Bits <= System_Word_Size
or else (Len_Bits <= System_Max_Binary_Modulus_Power
and then Support_Long_Shifts_On_Target))
-
- -- Also test for alignment given. If an alignment is given which
- -- is smaller than the natural modular alignment, force the array
- -- of bytes representation to accommodate the alignment.
-
- and then
- (No (Alignment_Clause (Typ))
- or else
- Alignment (Typ) >= ((Len_Bits + System_Storage_Unit)
- / System_Storage_Unit))
then
-- We can use the modular type, it has the form:
@@ -1193,6 +1183,14 @@ package body Exp_Pakd is
end if;
Install_PAT;
+
+ -- Propagate a given alignment to the modular type. This can
+ -- cause it to be under-aligned, but that's OK.
+
+ if Present (Alignment_Clause (Typ)) then
+ Set_Alignment (PAT, Alignment (Typ));
+ end if;
+
return;
end if;
end if;
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 0b620a0c0b4f..6da9ce4a0ae6 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1593,6 +1593,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_to_gnu_type
(Original_Array_Type (gnat_entity)));
+ /* We have to handle clauses that under-align the type specially. */
+ if ((Present (Alignment_Clause (gnat_entity))
+ || (Is_Packed_Array_Type (gnat_entity)
+ && Present
+ (Alignment_Clause (Original_Array_Type (gnat_entity)))))
+ && UI_Is_In_Int_Range (Alignment (gnat_entity)))
+ {
+ align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT;
+ if (align >= TYPE_ALIGN (gnu_type))
+ align = 0;
+ }
+
/* If the type we are dealing with represents a bit-packed array,
we need to have the bits left justified on big-endian targets
and right justified on little-endian targets. We also need to
@@ -1605,39 +1617,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
tree gnu_field_type, gnu_field;
- /* Set the RM size before wrapping up the type. */
+ /* Set the RM size before wrapping up the original type. */
SET_TYPE_RM_SIZE (gnu_type,
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
+
+ /* Create a stripped-down declaration, mainly for debugging. */
+ create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+ debug_info_p, gnat_entity);
+
+ /* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM");
-
- /* Propagate the alignment of the modular type to the record.
- This means that bit-packed arrays have "ceil" alignment for
- their size, which may seem counter-intuitive but makes it
- possible to easily overlay them on modular types. */
- TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_field_type);
TYPE_PACKED (gnu_type) = 1;
+ TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+ TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+ SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+
+ /* Propagate the alignment of the modular type to the record type,
+ unless there is an alignment clause that under-aligns the type.
+ This means that bit-packed arrays are given "ceil" alignment for
+ their size by default, which may seem counter-intuitive but makes
+ it possible to overlay them on modular types easily. */
+ TYPE_ALIGN (gnu_type)
+ = align > 0 ? align : TYPE_ALIGN (gnu_field_type);
- /* Create a stripped-down declaration of the original type, mainly
- for debugging. */
- create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
- debug_info_p, gnat_entity);
+ relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
/* Don't notify the field as "addressable", since we won't be taking
it's address and it would prevent create_field_decl from making a
bitfield. */
gnu_field = create_field_decl (get_identifier ("OBJECT"),
- gnu_field_type, gnu_type, 1, 0, 0, 0);
+ gnu_field_type, gnu_type, 1,
+ NULL_TREE, bitsize_zero_node, 0);
/* Do not emit debug info until after the parallel type is added. */
- finish_record_type (gnu_type, gnu_field, 0, false);
+ finish_record_type (gnu_type, gnu_field, 2, false);
+ compute_record_mode (gnu_type);
TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
- relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
-
if (debug_info_p)
{
/* Make the original array type a parallel type. */
@@ -1653,45 +1673,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If the type we are dealing with has got a smaller alignment than the
natural one, we need to wrap it up in a record type and under-align
the latter. We reuse the padding machinery for this purpose. */
- else if (Present (Alignment_Clause (gnat_entity))
- && UI_Is_In_Int_Range (Alignment (gnat_entity))
- && (align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT)
- && align < TYPE_ALIGN (gnu_type))
+ else if (align > 0)
{
tree gnu_field_type, gnu_field;
/* Set the RM size before wrapping up the type. */
SET_TYPE_RM_SIZE (gnu_type,
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
+
+ /* Create a stripped-down declaration, mainly for debugging. */
+ create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+ debug_info_p, gnat_entity);
+
+ /* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD");
-
- TYPE_ALIGN (gnu_type) = align;
TYPE_PACKED (gnu_type) = 1;
-
- /* Create a stripped-down declaration of the original type, mainly
- for debugging. */
- create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
- debug_info_p, gnat_entity);
+ TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+ TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+ SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+ TYPE_ALIGN (gnu_type) = align;
+ relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
/* Don't notify the field as "addressable", since we won't be taking
it's address and it would prevent create_field_decl from making a
bitfield. */
- gnu_field = create_field_decl (get_identifier ("OBJECT"),
- gnu_field_type, gnu_type, 1, 0, 0, 0);
+ gnu_field = create_field_decl (get_identifier ("F"),
+ gnu_field_type, gnu_type, 1,
+ NULL_TREE, bitsize_zero_node, 0);
- finish_record_type (gnu_type, gnu_field, 0, debug_info_p);
+ finish_record_type (gnu_type, gnu_field, 2, debug_info_p);
+ compute_record_mode (gnu_type);
TYPE_PADDING_P (gnu_type) = 1;
-
- relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
}
- /* Otherwise reset the alignment lest we computed it above. */
- else
- align = 0;
-
break;
case E_Floating_Point_Type:
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 1444d6e8bccd..ecb0495356a7 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -595,10 +595,10 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
if (rep_level > 0)
{
TYPE_ALIGN (record_type) = MAX (BITS_PER_UNIT, TYPE_ALIGN (record_type));
- SET_TYPE_MODE (record_type, BLKmode);
if (!had_size_unit)
TYPE_SIZE_UNIT (record_type) = size_zero_node;
+
if (!had_size)
TYPE_SIZE (record_type) = bitsize_zero_node;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cb2412ee8d39..5f8db2c80a3a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-04-07 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/bit_packed_array.ad[sb]: Rename into...
+ * gnat.dg/bit_packed_array1.ad[sb]: ...this.
+ * gnat.dg/bit_packed_array4.ad[sb]: New test.
+
2010-04-07 Jie Zhang <jie@codesourcery.com>
PR c++/42556
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array.adb b/gcc/testsuite/gnat.dg/bit_packed_array1.adb
similarity index 84%
rename from gcc/testsuite/gnat.dg/bit_packed_array.adb
rename to gcc/testsuite/gnat.dg/bit_packed_array1.adb
index fcdd69eb47bd..10fd2921f542 100644
--- a/gcc/testsuite/gnat.dg/bit_packed_array.adb
+++ b/gcc/testsuite/gnat.dg/bit_packed_array1.adb
@@ -3,7 +3,7 @@
-- { dg-do compile }
-package body Bit_Packed_Array is
+package body Bit_Packed_Array1 is
procedure Generate_Callforward is
Compiler_Crash : String :=
@@ -13,4 +13,4 @@ package body Bit_Packed_Array is
null;
end Generate_Callforward;
-end Bit_Packed_Array;
+end Bit_Packed_Array1;
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array.ads b/gcc/testsuite/gnat.dg/bit_packed_array1.ads
similarity index 85%
rename from gcc/testsuite/gnat.dg/bit_packed_array.ads
rename to gcc/testsuite/gnat.dg/bit_packed_array1.ads
index 525536ee6460..a0d5ab7a8df7 100644
--- a/gcc/testsuite/gnat.dg/bit_packed_array.ads
+++ b/gcc/testsuite/gnat.dg/bit_packed_array1.ads
@@ -1,13 +1,14 @@
with Interfaces;
-package Bit_Packed_Array is
+package Bit_Packed_Array1 is
type laser_illuminator_code_group_t is (zero, one);
pragma Convention (C, laser_illuminator_code_group_t);
subtype lic_array_index_t is Interfaces.Unsigned_8 range 0 .. 3;
- type lic_array_t is array (lic_array_index_t) of laser_illuminator_code_group_t;
+ type lic_array_t is array (lic_array_index_t)
+ of laser_illuminator_code_group_t;
pragma Convention (C, lic_array_t);
type Eighty_Bytes_T is array (1 .. 80) of Interfaces.Unsigned_8;
@@ -30,4 +31,4 @@ package Bit_Packed_Array is
procedure Generate_Callforward;
-end Bit_Packed_Array;
+end Bit_Packed_Array1;
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array4.adb b/gcc/testsuite/gnat.dg/bit_packed_array4.adb
new file mode 100644
index 000000000000..35088a7eba46
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array4.adb
@@ -0,0 +1,11 @@
+-- { dg-do compile }
+
+package body Bit_Packed_Array4 is
+
+ procedure Process (M : Message_Type) is
+ D : Data_Type;
+ begin
+ D := M.Data;
+ end;
+
+end Bit_Packed_Array4;
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array4.ads b/gcc/testsuite/gnat.dg/bit_packed_array4.ads
new file mode 100644
index 000000000000..7713e8f3e5b7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array4.ads
@@ -0,0 +1,18 @@
+package Bit_Packed_Array4 is
+
+ type Data_Type is array (1 .. 39) of Boolean;
+ pragma Pack (Data_Type);
+ for Data_Type'Alignment use 1;
+
+ type Message_Type is record
+ Valid : Boolean;
+ Data : Data_Type;
+ end record;
+ for Message_Type use record
+ Valid at 0 range 0 .. 0;
+ Data at 0 range 1 .. 39;
+ end record;
+
+ procedure Process (M : Message_Type);
+
+end Bit_Packed_Array4;
--
GitLab