* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158056 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 09469ac..c740fa8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,17 @@
 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
        alignment on the RETURN type built for the Copy-In Copy-Out mechanism.
 

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index ed7ac4b..c1d25c2 100644 (file)
--- 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 0b620a0..6da9ce4 100644 (file)
--- 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 1444d6e..ecb0495 100644 (file)
--- 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 cb2412e..5f8db2c 100644 (file)
--- 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 fcdd69e..10fd292 100644 (file)
--- 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 525536e..a0d5ab7 100644 (file)
--- 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 (file)
index 0000000..35088a7
--- /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 (file)
index 0000000..7713e8f
--- /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;