mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 01:20:52 +08:00
ttypes.ads (Target_Double_Float_Alignment): New variable.
* 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. From-SVN: r146675
This commit is contained in:
parent
1275de7d6e
commit
caa9d12a2b
@ -1,3 +1,38 @@
|
||||
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
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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:
|
||||
|
@ -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. */
|
||||
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
@ -1,3 +1,8 @@
|
||||
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.
|
||||
|
24
gcc/testsuite/gnat.dg/alignment7.adb
Normal file
24
gcc/testsuite/gnat.dg/alignment7.adb
Normal file
@ -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;
|
24
gcc/testsuite/gnat.dg/alignment8.adb
Normal file
24
gcc/testsuite/gnat.dg/alignment8.adb
Normal file
@ -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;
|
Loading…
x
Reference in New Issue
Block a user