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

 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.
 

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;

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:

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;
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gnat.dg/bit_packed_array.adb → 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;

gcc/testsuite/gnat.dg/bit_packed_array.ads → gcc/testsuite/gnat.dg/bit_packed_array1.ads

 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;

gcc/testsuite/gnat.dg/bit_packed_array4.adb

+-- { 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;

gcc/testsuite/gnat.dg/bit_packed_array4.ads

+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;