Commit caa9d12a by Eric Botcazou Committed by Eric Botcazou

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
parent 1275de7d
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.
......
......@@ -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)
{
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,6 +1377,9 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
break;
case Attr_Alignment:
{
unsigned int align;
if (TREE_CODE (gnu_prefix) == COMPONENT_REF
&& (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
== RECORD_TYPE)
......@@ -1385,9 +1390,40 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnu_result_type = get_unpadded_type (Etype (gnat_node));
prefix_unused = true;
gnu_result = size_int ((TREE_CODE (gnu_prefix) == COMPONENT_REF
? DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1))
: TYPE_ALIGN (gnu_type)) / BITS_PER_UNIT);
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;
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.
......
-- { 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;
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment