* ttypes.ads (Target_Double_Float_Alignment): New variable.

	(Target_Double_Scalar_Alignment): Likewise.
	* get_targ.ads (Get_Strict_Alignment): Adjust external name.
	(Get_Double_Float_Alignment): New imported function.
	(Get_Double_Scalar_Alignment): Likewise.
	* layout.adb (Set_Elem_Alignment): Take into account specific caps for
	the alignment of "double" floating-point types and "double" or larger
	scalar types, as parameterized by Target_Double_Float_Alignment and
	Target_Double_Scalar_Alignment respectively.
	* gcc-interface/gigi.h (double_float_alignment): Declare.
	(double_scalar_alignment): Likewise.
	(is_double_float_or_array): Likewise.
	(is_double_scalar_or_array): Likewise.
	(get_target_double_float_alignment): Likewise.
	(get_target_double_scalar_alignment): Likewise.
	* gcc-interface/targtyps.c (get_strict_alignment): Rename into...
	(get_target_strict_alignment): ...this.
	(get_target_double_float_alignment): New function.
	(get_target_double_scalar_alignment): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
	Test the presence of an alignment clause for under-aligned integer
	types.  Take into account specific caps for the alignment of "double"
	floating-point types and "double" or larger scalar types, as
	parameterized by Target_Double_Float_Alignment and
	Target_Double_Scalar_Alignment respectively.
	(validate_alignment): Likewise.
	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Alignment>: Likewise.
	(gigi): Initialize double_float_alignment and double_scalar_alignment.
	* gcc-interface/utils.c (double_float_alignment): New global variable.
	(double_scalar_alignment): Likewise.
	(is_double_float_or_array): New predicate.
	(is_double_scalar_or_array): Likewise.


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

12 files changed, 374 insertions, 39 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e27aad1724e..298c554a329 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,40 @@
 2009-04-24  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* ttypes.ads (Target_Double_Float_Alignment): New variable.
+	(Target_Double_Scalar_Alignment): Likewise.
+	* get_targ.ads (Get_Strict_Alignment): Adjust external name.
+	(Get_Double_Float_Alignment): New imported function.
+	(Get_Double_Scalar_Alignment): Likewise.
+	* layout.adb (Set_Elem_Alignment): Take into account specific caps for
+	the alignment of "double" floating-point types and "double" or larger
+	scalar types, as parameterized by Target_Double_Float_Alignment and
+	Target_Double_Scalar_Alignment respectively.
+	* gcc-interface/gigi.h (double_float_alignment): Declare.
+	(double_scalar_alignment): Likewise.
+	(is_double_float_or_array): Likewise.
+	(is_double_scalar_or_array): Likewise.
+	(get_target_double_float_alignment): Likewise.
+	(get_target_double_scalar_alignment): Likewise.
+	* gcc-interface/targtyps.c (get_strict_alignment): Rename into...
+	(get_target_strict_alignment): ...this.
+	(get_target_double_float_alignment): New function.
+	(get_target_double_scalar_alignment): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
+	Test the presence of an alignment clause for under-aligned integer
+	types.  Take into account specific caps for the alignment of "double"
+	floating-point types and "double" or larger scalar types, as
+	parameterized by Target_Double_Float_Alignment and
+	Target_Double_Scalar_Alignment respectively.
+	(validate_alignment): Likewise.
+	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Alignment>: Likewise.
+	(gigi): Initialize double_float_alignment and double_scalar_alignment.
+	* gcc-interface/utils.c (double_float_alignment): New global variable.
+	(double_scalar_alignment): Likewise.
+	(is_double_float_or_array): New predicate.
+	(is_double_scalar_or_array): Likewise.
+
+2009-04-24  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/utils2.c (build_cond_expr): Move SAVE_EXPR ahead of
 	the conditional expression only if it is common to both arms.
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index c25fb91ef8e..3575aa55b9d 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1662,7 +1662,7 @@ 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 (Known_Alignment (gnat_entity)
+      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))
@@ -4661,8 +4661,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       /* Back-annotate the Alignment of the type if not already in the
 	 tree.  Likewise for sizes.  */
       if (Unknown_Alignment (gnat_entity))
-	Set_Alignment (gnat_entity,
-		       UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
+	{
+	  unsigned int double_align, align;
+	  bool is_capped_double, align_clause;
+
+	  /* If the default alignment of "double" or larger scalar types is
+	     specifically capped and this is not an array with an alignment
+	     clause on the component type, return the cap.  */
+	  if ((double_align = double_float_alignment) > 0)
+	    is_capped_double
+	      = is_double_float_or_array (gnat_entity, &align_clause);
+	  else if ((double_align = double_scalar_alignment) > 0)
+	    is_capped_double
+	      = is_double_scalar_or_array (gnat_entity, &align_clause);
+	  else
+	    is_capped_double = align_clause = false;
+
+	  if (is_capped_double && !align_clause)
+	    align = double_align;
+	  else
+	    align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
+
+	  Set_Alignment (gnat_entity, UI_From_Int (align));
+	}
 
       if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
 	{
@@ -7507,9 +7528,47 @@ validate_alignment (Uint alignment, Entity_Id gnat_entity, unsigned int align)
   else if (!(Present (Alignment_Clause (gnat_entity))
 	     && From_At_Mod (Alignment_Clause (gnat_entity)))
 	   && new_align * BITS_PER_UNIT < align)
-    post_error_ne_num ("alignment for& must be at least ^",
-		       gnat_error_node, gnat_entity,
-		       align / BITS_PER_UNIT);
+    {
+      unsigned int double_align;
+      bool is_capped_double, align_clause;
+
+      /* If the default alignment of "double" or larger scalar types is
+	 specifically capped and the new alignment is above the cap, do
+	 not post an error and change the alignment only if there is an
+	 alignment clause; this makes it possible to have the associated
+	 GCC type overaligned by default for performance reasons.  */
+      if ((double_align = double_float_alignment) > 0)
+	{
+	  Entity_Id gnat_type
+	    = Is_Type (gnat_entity) ? gnat_entity : Etype (gnat_entity);
+	  is_capped_double
+	    = is_double_float_or_array (gnat_type, &align_clause);
+	}
+      else if ((double_align = double_scalar_alignment) > 0)
+	{
+	  Entity_Id gnat_type
+	    = Is_Type (gnat_entity) ? gnat_entity : Etype (gnat_entity);
+	  is_capped_double
+	    = is_double_scalar_or_array (gnat_type, &align_clause);
+	}
+      else
+	is_capped_double = align_clause = false;
+
+      if (is_capped_double && new_align >= double_align)
+	{
+	  if (align_clause)
+	    align = new_align * BITS_PER_UNIT;
+	}
+      else
+	{
+	  if (is_capped_double)
+	    align = double_align * BITS_PER_UNIT;
+
+	  post_error_ne_num ("alignment for& must be at least ^",
+			     gnat_error_node, gnat_entity,
+			     align / BITS_PER_UNIT);
+	}
+    }
   else
     {
       new_align = (new_align > 0 ? new_align * BITS_PER_UNIT : 1);
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index fb183bf09d5..8ccb39c4b0a 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -268,6 +268,16 @@ extern int max_gnat_nodes;
 /* If nonzero, pretend we are allocating at global level.  */
 extern int force_global;
 
+/* The default alignment of "double" floating-point types, i.e. floating
+   point types whose size is equal to 64 bits, or 0 if this alignment is
+   not specifically capped.  */
+extern int double_float_alignment;
+
+/* The default alignment of "double" or larger scalar types, i.e. scalar
+   types whose size is greater or equal to 64 bits, or 0 if this alignment
+   is not specifically capped.  */
+extern int double_scalar_alignment;
+
 /* Standard data type sizes.  Most of these are not used.  */
 
 #ifndef CHAR_TYPE_SIZE
@@ -730,6 +740,20 @@ extern tree unchecked_convert (tree type, tree expr, bool notrunc_p);
    the latter being a record type as predicated by Is_Record_Type.  */
 extern enum tree_code tree_code_for_record_type (Entity_Id gnat_type);
 
+/* Return true if GNAT_TYPE is a "double" floating-point type, i.e. whose
+   size is equal to 64 bits, or an array of such a type.  Set ALIGN_CLAUSE
+   according to the presence of an alignment clause on the type or, if it
+   is an array, on the component type.  */
+extern bool is_double_float_or_array (Entity_Id gnat_type,
+				      bool *align_clause);
+
+/* Return true if GNAT_TYPE is a "double" or larger scalar type, i.e. whose
+   size is greater or equal to 64 bits, or an array of such a type.  Set
+   ALIGN_CLAUSE according to the presence of an alignment clause on the
+   type or, if it is an array, on the component type.  */
+extern bool is_double_scalar_or_array (Entity_Id gnat_type,
+				       bool *align_clause);
+
 /* Return true if GNU_TYPE is suitable as the type of a non-aliased
    component of an aggregate type.  */
 extern bool type_for_nonaliased_component_p (tree gnu_type);
@@ -899,15 +923,17 @@ extern Pos get_target_float_size (void);
 extern Pos get_target_double_size (void);
 extern Pos get_target_long_double_size (void);
 extern Pos get_target_pointer_size (void);
-extern Pos get_target_maximum_alignment (void);
-extern Pos get_target_default_allocator_alignment (void);
 extern Pos get_target_maximum_default_alignment (void);
+extern Pos get_target_default_allocator_alignment (void);
 extern Pos get_target_maximum_allowed_alignment (void);
+extern Pos get_target_maximum_alignment (void);
 extern Nat get_float_words_be (void);
 extern Nat get_words_be (void);
 extern Nat get_bytes_be (void);
 extern Nat get_bits_be (void);
-extern Nat get_strict_alignment (void);
+extern Nat get_target_strict_alignment (void);
+extern Nat get_target_double_float_alignment (void);
+extern Nat get_target_double_scalar_alignment (void);
 
 /* Let code know whether we are targetting VMS without need of
    intrusive preprocessor directives.  */
@@ -921,4 +947,3 @@ extern Nat get_strict_alignment (void);
 #ifndef TARGET_MALLOC64
 #define TARGET_MALLOC64 0
 #endif
-
diff --git a/gcc/ada/gcc-interface/targtyps.c b/gcc/ada/gcc-interface/targtyps.c
index ed608e57ae9..3b8aa5cc9f5 100644
--- a/gcc/ada/gcc-interface/targtyps.c
+++ b/gcc/ada/gcc-interface/targtyps.c
@@ -127,7 +127,6 @@ get_target_long_double_size (void)
   return fp_prec_to_size (WIDEST_HARDWARE_FP_SIZE);
 }
 
-
 Pos
 get_target_pointer_size (void)
 {
@@ -217,7 +216,30 @@ get_bits_be (void)
 }
 
 Nat
-get_strict_alignment (void)
+get_target_strict_alignment (void)
 {
   return STRICT_ALIGNMENT;
 }
+
+Nat
+get_target_double_float_alignment (void)
+{
+#ifdef TARGET_ALIGN_NATURAL
+  /* This macro is only defined by the rs6000 port.  */
+  if (!TARGET_ALIGN_NATURAL
+      && (DEFAULT_ABI == ABI_AIX || DEFAULT_ABI == ABI_DARWIN))
+    return 32 / BITS_PER_UNIT;
+#endif
+  return 0;
+}
+
+Nat
+get_target_double_scalar_alignment (void)
+{
+#ifdef TARGET_ALIGN_DOUBLE
+  /* This macro is only defined by the i386 port.  */
+  if (!TARGET_ALIGN_DOUBLE && !TARGET_64BIT)
+    return 32 / BITS_PER_UNIT;
+#endif
+  return 0;
+}
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index de6ac0b1ead..d6aa7dfa123 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -317,6 +317,10 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   if (!Stack_Check_Probes_On_Target)
     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
 
+  /* Retrieve alignment settings.  */
+  double_float_alignment = get_target_double_float_alignment ();
+  double_scalar_alignment = get_target_double_scalar_alignment ();
+
   /* Record the builtin types.  Define `integer' and `unsigned char' first so
      that dbx will output them first.  */
   record_builtin_type ("integer", integer_type_node);
@@ -1066,12 +1070,10 @@ Pragma_to_gnu (Node_Id gnat_node)
 static tree
 Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 {
-  tree gnu_result = error_mark_node;
-  tree gnu_result_type;
-  tree gnu_expr;
-  bool prefix_unused = false;
   tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
   tree gnu_type = TREE_TYPE (gnu_prefix);
+  tree gnu_expr, gnu_result_type, gnu_result = error_mark_node;
+  bool prefix_unused = false;
 
   /* If the input is a NULL_EXPR, make a new one.  */
   if (TREE_CODE (gnu_prefix) == NULL_EXPR)
@@ -1375,19 +1377,53 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       break;
 
     case Attr_Alignment:
-      if (TREE_CODE (gnu_prefix) == COMPONENT_REF
-	  && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
-	      == RECORD_TYPE)
-	  && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
-	gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
+      {
+	unsigned int align;
 
-      gnu_type = TREE_TYPE (gnu_prefix);
-      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-      prefix_unused = true;
+	if (TREE_CODE (gnu_prefix) == COMPONENT_REF
+	    && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
+		== RECORD_TYPE)
+	    && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
+	  gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
 
-      gnu_result = size_int ((TREE_CODE (gnu_prefix) == COMPONENT_REF
-			      ? DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1))
-			      : TYPE_ALIGN (gnu_type)) / BITS_PER_UNIT);
+	gnu_type = TREE_TYPE (gnu_prefix);
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+	prefix_unused = true;
+
+	if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
+	  align = DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1)) / BITS_PER_UNIT;
+	else
+	  {
+	    Node_Id gnat_prefix = Prefix (gnat_node);
+	    Entity_Id gnat_type = Etype (gnat_prefix);
+	    unsigned int double_align;
+	    bool is_capped_double, align_clause;
+
+	    /* If the default alignment of "double" or larger scalar types is
+	       specifically capped and there is an alignment clause neither
+	       on the type nor on the prefix itself, return the cap.  */
+	    if ((double_align = double_float_alignment) > 0)
+	      is_capped_double
+		= is_double_float_or_array (gnat_type, &align_clause);
+	    else if ((double_align = double_scalar_alignment) > 0)
+	      is_capped_double
+		= is_double_scalar_or_array (gnat_type, &align_clause);
+	    else
+	      is_capped_double = align_clause = false;
+
+	    if (is_capped_double
+		&& Nkind (gnat_prefix) == N_Identifier
+		&& Present (Alignment_Clause (Entity (gnat_prefix))))
+	      align_clause = true;
+
+	    if (is_capped_double && !align_clause)
+	      align = double_align;
+	    else
+	      align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
+	  }
+
+	gnu_result = size_int (align);
+      }
       break;
 
     case Attr_First:
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index ad3909fa859..e3cf9756ea3 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -74,6 +74,16 @@
 /* If nonzero, pretend we are allocating at global level.  */
 int force_global;
 
+/* The default alignment of "double" floating-point types, i.e. floating
+   point types whose size is equal to 64 bits, or 0 if this alignment is
+   not specifically capped.  */
+int double_float_alignment;
+
+/* The default alignment of "double" or larger scalar types, i.e. scalar
+   types whose size is greater or equal to 64 bits, or 0 if this alignment
+   is not specifically capped.  */
+int double_scalar_alignment;
+
 /* Tree nodes for the various types and decls we create.  */
 tree gnat_std_decls[(int) ADT_LAST];
 
@@ -4564,6 +4574,62 @@ tree_code_for_record_type (Entity_Id gnat_type)
   return UNION_TYPE;
 }
 
+/* Return true if GNAT_TYPE is a "double" floating-point type, i.e. whose
+   size is equal to 64 bits, or an array of such a type.  Set ALIGN_CLAUSE
+   according to the presence of an alignment clause on the type or, if it
+   is an array, on the component type.  */
+
+bool
+is_double_float_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+  gnat_type = Underlying_Type (gnat_type);
+
+  *align_clause = Present (Alignment_Clause (gnat_type));
+
+  if (Is_Array_Type (gnat_type))
+    {
+      gnat_type = Underlying_Type (Component_Type (gnat_type));
+      if (Present (Alignment_Clause (gnat_type)))
+	*align_clause = true;
+    }
+
+  if (!Is_Floating_Point_Type (gnat_type))
+    return false;
+
+  if (UI_To_Int (Esize (gnat_type)) != 64)
+    return false;
+
+  return true;
+}
+
+/* Return true if GNAT_TYPE is a "double" or larger scalar type, i.e. whose
+   size is greater or equal to 64 bits, or an array of such a type.  Set
+   ALIGN_CLAUSE according to the presence of an alignment clause on the
+   type or, if it is an array, on the component type.  */
+
+bool
+is_double_scalar_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+  gnat_type = Underlying_Type (gnat_type);
+
+  *align_clause = Present (Alignment_Clause (gnat_type));
+
+  if (Is_Array_Type (gnat_type))
+    {
+      gnat_type = Underlying_Type (Component_Type (gnat_type));
+      if (Present (Alignment_Clause (gnat_type)))
+	*align_clause = true;
+    }
+
+  if (!Is_Scalar_Type (gnat_type))
+    return false;
+
+  if (UI_To_Int (Esize (gnat_type)) < 64)
+    return false;
+
+  return true;
+}
+
 /* Return true if GNU_TYPE is suitable as the type of a non-aliased
    component of an aggregate type.  */
 
diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads
index 8a3d0857e04..07a9ab2db6f 100644
--- a/gcc/ada/get_targ.ads
+++ b/gcc/ada/get_targ.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -93,7 +93,15 @@ package Get_Targ is
    pragma Import (C, Get_Bits_BE, "get_bits_be");
 
    function Get_Strict_Alignment return Nat;
-   pragma Import (C, Get_Strict_Alignment, "get_strict_alignment");
+   pragma Import (C, Get_Strict_Alignment, "get_target_strict_alignment");
+
+   function Get_Double_Float_Alignment return Nat;
+   pragma Import (C, Get_Double_Float_Alignment,
+                  "get_target_double_float_alignment");
+
+   function Get_Double_Scalar_Alignment return Nat;
+   pragma Import (C, Get_Double_Scalar_Alignment,
+                  "get_target_double_scalar_alignment");
 
    function Get_Max_Unaligned_Field return Pos;
    --  Returns the maximum supported size in bits for a field that is
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index 7c392209b8f..4e721539d87 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -3033,15 +3033,36 @@ package body Layout is
       --  the type, or the maximum allowed alignment.
 
       declare
-         S : constant Int :=
-               UI_To_Int (Esize (E)) / SSU;
-         A : Nat;
+         S : constant Int := UI_To_Int (Esize (E)) / SSU;
+         Max_Alignment, A : Nat;
 
       begin
+         --  If the default alignment of "double" floating-point types is
+         --  specifically capped, enforce the cap.
+
+         if Ttypes.Target_Double_Float_Alignment > 0
+           and then S = 8
+           and then Is_Floating_Point_Type (E)
+         then
+            Max_Alignment := Ttypes.Target_Double_Float_Alignment;
+
+         --  If the default alignment of "double" or larger scalar types is
+         --  specifically capped, enforce the cap.
+
+         elsif Ttypes.Target_Double_Scalar_Alignment > 0
+           and then S >= 8
+           and then Is_Scalar_Type (E)
+         then
+            Max_Alignment := Ttypes.Target_Double_Scalar_Alignment;
+
+         --  Otherwise enforce the overall alignment cap
+
+         else
+            Max_Alignment := Ttypes.Maximum_Alignment;
+         end if;
+
          A := 1;
-         while 2 * A <= Ttypes.Maximum_Alignment
-            and then 2 * A <= S
-         loop
+         while 2 * A <= Max_Alignment and then 2 * A <= S loop
             A := 2 * A;
          end loop;
 
diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads
index a9016893731..01b86e336a6 100644
--- a/gcc/ada/ttypes.ads
+++ b/gcc/ada/ttypes.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -81,10 +81,10 @@ package Ttypes is
    --  for all targets.
 
    --  Note that during compilation there are two versions of package System
-   --  around. The version that is directly WITH'ed by compiler packages
+   --  around. The version that is directly with'ed by compiler packages
    --  contains host-dependent definitions, which is what is needed in that
    --  case (for example, System.Storage_Unit referenced in the source of the
-   --  compiler refers to the storage unit of the host, not the target. This
+   --  compiler refers to the storage unit of the host, not the target). This
    --  means that, like attribute references, any references to constants in
    --  package System in the compiler code are suspicious, since it is strange
    --  for the compiler to have such host dependencies. If the compiler needs
@@ -205,4 +205,14 @@ package Ttypes is
    Target_Strict_Alignment : Boolean := Get_Strict_Alignment /= 0;
    --  True if instructions will fail if data is misaligned
 
+   Target_Double_Float_Alignment : Nat := Get_Double_Float_Alignment;
+   --  The default alignment of "double" floating-point types, i.e. floating-
+   --  point types whose size is equal to 64 bits, or 0 if this alignment is
+   --  not specifically capped.
+
+   Target_Double_Scalar_Alignment : Nat := Get_Double_Scalar_Alignment;
+   --  The default alignment of "double" or larger scalar types, i.e. scalar
+   --  types whose size is greater or equal to 64 bits, or 0 if this alignment
+   --  is not specifically capped.
+
 end Ttypes;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 592aac6d985..3af0f6f3dde 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2009-04-24  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/alignment7.adb: New test.
+	* gnat.dg/alignment8.adb: Likewise.
+
+2009-04-24  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gnat.dg/specs/pr34799.ads: Rename to rep_clause1.ads.
 	* gnat.dg/specs/rep_clause2.ads: New test.
 
diff --git a/gcc/testsuite/gnat.dg/alignment7.adb b/gcc/testsuite/gnat.dg/alignment7.adb
new file mode 100644
index 00000000000..5a3b8eb43c8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/alignment7.adb
@@ -0,0 +1,24 @@
+-- { dg-do run }
+
+with System;
+
+procedure Alignment7 is
+
+  type R is record
+    I : Integer;
+    F : Long_Float;
+  end record;
+  for R'Alignment use 8;
+
+  procedure Q (A : System.Address) is
+    F : Long_Float;
+    for F'Address use A;
+  begin
+    F := 0.0;
+  end;
+
+  V : R;
+
+begin
+  Q (V.F'Address);
+end;
diff --git a/gcc/testsuite/gnat.dg/alignment8.adb b/gcc/testsuite/gnat.dg/alignment8.adb
new file mode 100644
index 00000000000..06136c36e0e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/alignment8.adb
@@ -0,0 +1,24 @@
+-- { dg-do run }
+
+with System;
+
+procedure Alignment8 is
+
+  type R is record
+    I : Integer;
+    F : Long_Long_Integer;
+  end record;
+  for R'Alignment use 8;
+
+  procedure Q (A : System.Address) is
+    F : Long_Long_Integer;
+    for F'Address use A;
+  begin
+    F := 0;
+  end;
+
+  V : R;
+
+begin
+  Q (V.F'Address);
+end;