OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gnat_to_gnu_entity): If -gnatd.a and not optimizing alignment for space... 

* decl.c (gnat_to_gnu_entity) <object>: If -gnatd.a and not optimizing
	alignment for space, promote the alignment of non-scalar variables with
	no size and alignment.
	* gigi.h (gnat_types_compatible_p): Declare.
	* misc.c (LANG_HOOKS_TYPES_COMPATIBLE_P): Set to above predicate.
	* trans.c (gnat_to_gnu): Revert revision 129339 change.  Minor cleanup.
	* utils.c (gnat_types_compatible_p) : New predicate.
	(convert): Use it throughout to test for cases where a mere view
	conversion is sufficient.
	* utils2.c (build_binary_op): Minor tweaks.
	(build_unary_op): Likewise.

From-SVN: r134092
This commit is contained in:
Eric Botcazou 2008-04-08 11:41:59 +00:00 committed by Eric Botcazou
parent 373140ef74
commit ba3f46d091
7 changed files with 167 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (gnat_to_gnu_entity) <object>: If -gnatd.a and not optimizing
alignment for space, promote the alignment of non-scalar variables with
no size and alignment.
* gigi.h (gnat_types_compatible_p): Declare.
* misc.c (LANG_HOOKS_TYPES_COMPATIBLE_P): Set to above predicate.
* trans.c (gnat_to_gnu): Revert revision 129339 change. Minor cleanup.
* utils.c (gnat_types_compatible_p) : New predicate.
(convert): Use it throughout to test for cases where a mere view
conversion is sufficient.
* utils2.c (build_binary_op): Minor tweaks.
(build_unary_op): Likewise.
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (adjust_packed): Expand comment.

39
gcc/ada/decl.c
View File

@ -672,19 +672,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !Present (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node;
/* If this is an atomic object with no specified size and alignment,
but where the size of the type is a constant, set the alignment to
the smallest not less than the size, or to the biggest meaningful
alignment, whichever is smaller. */
if (Is_Atomic (gnat_entity) && !gnu_size && align == 0
/* If this is an object with no specified size and alignment, and if
either it is atomic or we are not optimizing alignment for space
and it is a non-scalar variable, and the size of its type is a
constant, set the alignment to the smallest not less than the
size, or to the biggest meaningful one, whichever is smaller. */
if (!gnu_size && align == 0
&& (Is_Atomic (gnat_entity)
|| (Debug_Flag_Dot_A
&& !Optimize_Alignment_Space (gnat_entity)
&& kind == E_Variable
&& AGGREGATE_TYPE_P (gnu_type)
&& !const_flag && No (Renamed_Object (gnat_entity))
&& !imported_p && No (Address_Clause (gnat_entity))))
&& TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
{
/* No point in jumping through all the hoops needed in order
to support BIGGEST_ALIGNMENT if we don't really have to. */
unsigned int align_cap = Is_Atomic (gnat_entity)
? BIGGEST_ALIGNMENT
: MAX_FIXED_MODE_SIZE;
if (!host_integerp (TYPE_SIZE (gnu_type), 1)
|| 0 <= compare_tree_int (TYPE_SIZE (gnu_type),
BIGGEST_ALIGNMENT))
align = BIGGEST_ALIGNMENT;
|| compare_tree_int (TYPE_SIZE (gnu_type), align_cap) >= 0)
align = align_cap;
else
align = ceil_alignment (tree_low_cst (TYPE_SIZE (gnu_type), 1));
/* But make sure not to under-align the object. */
if (align < TYPE_ALIGN (gnu_type))
align = TYPE_ALIGN (gnu_type);
/* And honor the minimum valid atomic alignment, if any. */
#ifdef MINIMUM_ATOMIC_ALIGNMENT
if (align < MINIMUM_ATOMIC_ALIGNMENT)
align = MINIMUM_ATOMIC_ALIGNMENT;
#endif
}
/* If the object is set to have atomic components, find the component

4
gcc/ada/gigi.h
View File

@ -468,6 +468,10 @@ extern tree gnat_unsigned_type (tree type_node);
/* Return the signed version of a TYPE_NODE, a scalar type. */
extern tree gnat_signed_type (tree type_node);
/* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
transparently converted to each other. */
extern int gnat_types_compatible_p (tree t1, tree t2);
/* Create an expression whose value is that of EXPR,
converted to type TYPE. The TREE_TYPE of the value
is always TYPE. This function implements all reasonable

2
gcc/ada/misc.c
View File

@ -151,6 +151,8 @@ static tree gnat_type_max_size (const_tree);
#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
#undef LANG_HOOKS_TYPE_FOR_SIZE
#define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
#undef LANG_HOOKS_TYPES_COMPATIBLE_P
#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p
#undef LANG_HOOKS_ATTRIBUTE_TABLE
#define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table
#undef LANG_HOOKS_BUILTIN_FUNCTION

71
gcc/ada/trans.c
View File

@ -4832,34 +4832,41 @@ gnat_to_gnu (Node_Id gnat_node)
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
gnu_result = gnat_stabilize_reference (gnu_result, false);
/* Now convert the result to the proper type. If the type is void or if
we have no result, return error_mark_node to show we have no result.
If the type of the result is correct or if we have a label (which doesn't
have any well-defined type), return our result. Also don't do the
conversion if the "desired" type involves a PLACEHOLDER_EXPR in its size
since those are the cases where the front end may have the type wrong due
to "instantiating" the unconstrained record with discriminant values
or if this is a FIELD_DECL. If this is the Name of an assignment
statement or a parameter of a procedure call, return what we have since
the RHS has to be converted to our type there in that case, unless
GNU_RESULT_TYPE has a simpler size. Similarly, if the two types are
record types with the same name and GNU_RESULT_TYPE has BLKmode, don't
convert. This will be the case when we are converting from a packable
type to its actual type and we need those conversions to be NOPs in
order for assignments into these types to work properly. Finally,
don't convert integral types that are the operand of an unchecked
conversion since we need to ignore those conversions (for 'Valid).
Otherwise, convert the result to the proper type. */
/* Now convert the result to the result type, unless we are in one of the
following cases:
1. If this is the Name of an assignment statement or a parameter of
a procedure call, return the result almost unmodified since the
RHS will have to be converted to our type in that case, unless
the result type has a simpler size. Similarly, don't convert
integral types that are the operands of an unchecked conversion
since we need to ignore those conversions (for 'Valid).
2. If we have a label (which doesn't have any well-defined type), a
field or an error, return the result almost unmodified. Also don't
do the conversion if the result type involves a PLACEHOLDER_EXPR in
its size since those are the cases where the front end may have the
type wrong due to "instantiating" the unconstrained record with
discriminant values. Similarly, if the two types are record types
with the same name and the result type has BLKmode, don't convert.
This will be the case when we are converting from a packed version
of a type to its original type and we need those conversions to be
NOPs in order for assignments into these types to work properly.
3. If the type is void or if we have no result, return error_mark_node
to show we have no result.
4. Finally, if the type of the result is already correct. */
if (Present (Parent (gnat_node))
&& ((Nkind (Parent (gnat_node)) == N_Assignment_Statement
&& Name (Parent (gnat_node)) == gnat_node)
|| (Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
&& Name (Parent (gnat_node)) != gnat_node)
|| Nkind (Parent (gnat_node)) == N_Parameter_Association
|| (Nkind (Parent (gnat_node)) == N_Unchecked_Type_Conversion
&& !AGGREGATE_TYPE_P (gnu_result_type)
&& !AGGREGATE_TYPE_P (TREE_TYPE (gnu_result)))
|| Nkind (Parent (gnat_node)) == N_Parameter_Association)
&& !AGGREGATE_TYPE_P (TREE_TYPE (gnu_result))))
&& !(TYPE_SIZE (gnu_result_type)
&& TYPE_SIZE (TREE_TYPE (gnu_result))
&& (AGGREGATE_TYPE_P (gnu_result_type)
@ -4874,16 +4881,14 @@ gnat_to_gnu (Node_Id gnat_node)
&& !(TREE_CODE (gnu_result_type) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (gnu_result_type))))
{
/* In this case remove padding only if the inner object type is the
same as gnu_result_type or is of self-referential size (in that later
case it must be an object of unconstrained type with a default
discriminant). We want to avoid copying too much data. */
/* Remove padding only if the inner object is of self-referential
size: in that case it must be an object of unconstrained type
with a default discriminant and we want to avoid copying too
much data. */
if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
&& (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result)))
== gnu_result_type
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
(TREE_TYPE (gnu_result)))))))
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
(TREE_TYPE (gnu_result))))))
gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
gnu_result);
}
@ -4901,20 +4906,20 @@ gnat_to_gnu (Node_Id gnat_node)
&& TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
&& TYPE_MODE (gnu_result_type) == BLKmode))
{
/* Remove any padding record, but do nothing more in this case. */
/* Remove any padding. */
if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
gnu_result);
}
else if (gnu_result == error_mark_node
|| gnu_result_type == void_type_node)
gnu_result = error_mark_node;
else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
gnu_result = error_mark_node;
else if (gnu_result_type != TREE_TYPE (gnu_result))
gnu_result = convert (gnu_result_type, gnu_result);
/* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RESULT. */
/* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result. */
while ((TREE_CODE (gnu_result) == NOP_EXPR
|| TREE_CODE (gnu_result) == NON_LVALUE_EXPR)
&& TREE_TYPE (TREE_OPERAND (gnu_result, 0)) == TREE_TYPE (gnu_result))

81
gcc/ada/utils.c
View File

@ -2378,6 +2378,42 @@ gnat_signed_type (tree type_node)
return type;
}
/* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
transparently converted to each other. */
int
gnat_types_compatible_p (tree t1, tree t2)
{
enum tree_code code;
/* This is the default criterion. */
if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
return 1;
/* We only check structural equivalence here. */
if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
return 0;
/* Array types are also compatible if they are constrained and have
the same component type and the same domain. */
if (code == ARRAY_TYPE
&& TREE_TYPE (t1) == TREE_TYPE (t2)
&& tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (t1)),
TYPE_MIN_VALUE (TYPE_DOMAIN (t2)))
&& tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (t1)),
TYPE_MAX_VALUE (TYPE_DOMAIN (t2))))
return 1;
/* Padding record types are also compatible if they pad the same
type and have the same constant size. */
if (code == RECORD_TYPE
&& TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2)
&& TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
&& tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
return 1;
return 0;
}
/* EXP is an expression for the size of an object. If this size contains
discriminant references, replace them with the maximum (if MAX_P) or
@ -3368,15 +3404,15 @@ convert (tree type, tree expr)
/* If both input and output have padding and are of variable size, do this
as an unchecked conversion. Likewise if one is a mere variant of the
other, so we avoid a pointless unpad/repad sequence. */
else if (ecode == RECORD_TYPE && code == RECORD_TYPE
else if (code == RECORD_TYPE && ecode == RECORD_TYPE
&& TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| !TREE_CONSTANT (TYPE_SIZE (etype))
|| TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)))
|| gnat_types_compatible_p (type, etype)))
;
/* If the output type has padding, make a constructor to build the
record. */
/* If the output type has padding, convert to the inner type and
make a constructor to build the record. */
else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
{
/* If we previously converted from another type and our type is
@ -3387,12 +3423,15 @@ convert (tree type, tree expr)
expr = TREE_OPERAND (expr, 0);
/* If we are just removing the padding from expr, convert the original
object if we have variable size. That will avoid the need
for some variable-size temporaries. */
object if we have variable size in order to avoid the need for some
variable-size temporaries. Likewise if the padding is a mere variant
of the other, so we avoid a pointless unpad/repad sequence. */
if (TREE_CODE (expr) == COMPONENT_REF
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
&& !TREE_CONSTANT (TYPE_SIZE (type)))
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| gnat_types_compatible_p (type,
TREE_TYPE (TREE_OPERAND (expr, 0)))))
return convert (type, TREE_OPERAND (expr, 0));
/* If the result type is a padded type with a self-referentially-sized
@ -3506,14 +3545,9 @@ convert (tree type, tree expr)
break;
case CONSTRUCTOR:
/* If we are converting a CONSTRUCTOR to another constrained array type
with the same domain, just make a new one in the proper type. */
if (code == ecode && code == ARRAY_TYPE
&& TREE_TYPE (type) == TREE_TYPE (etype)
&& tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
TYPE_MIN_VALUE (TYPE_DOMAIN (etype)))
&& tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
TYPE_MAX_VALUE (TYPE_DOMAIN (etype))))
/* If we are converting a CONSTRUCTOR to a mere variant type, just make
a new one in the proper type. */
if (gnat_types_compatible_p (type, etype))
{
expr = copy_node (expr);
TREE_TYPE (expr) = type;
@ -3539,7 +3573,6 @@ convert (tree type, tree expr)
the inner operand to the output type is fine in most cases, it
might expose unexpected input/output type mismatches in special
circumstances so we avoid such recursive calls when we can. */
tree op0 = TREE_OPERAND (expr, 0);
/* If we are converting back to the original type, we can just
@ -3549,13 +3582,13 @@ convert (tree type, tree expr)
return op0;
/* Otherwise, if we're converting between two aggregate types, we
might be allowed to substitute the VIEW_CONVERT target type in
place or to just convert the inner expression. */
might be allowed to substitute the VIEW_CONVERT_EXPR target type
in place or to just convert the inner expression. */
if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
{
/* If we are converting between type variants, we can just
substitute the VIEW_CONVERT in place. */
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
/* If we are converting between mere variants, we can just
substitute the VIEW_CONVERT_EXPR in place. */
if (gnat_types_compatible_p (type, etype))
return build1 (VIEW_CONVERT_EXPR, type, op0);
/* Otherwise, we may just bypass the input view conversion unless
@ -3594,10 +3627,10 @@ convert (tree type, tree expr)
if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
/* If we're converting between two aggregate types that have the same main
variant, just make a VIEW_CONVER_EXPR. */
/* If we're converting between two aggregate types that are mere
variants, just make a VIEW_CONVERT_EXPR. */
else if (AGGREGATE_TYPE_P (type)
&& TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
&& gnat_types_compatible_p (type, etype))
return build1 (VIEW_CONVERT_EXPR, type, expr);
/* In all other cases of related types, make a NOP_EXPR. */

45
gcc/ada/utils2.c
View File

@ -633,8 +633,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
tree right_base_type = get_base_type (right_type);
tree operation_type = result_type;
tree best_type = NULL_TREE;
tree modulus;
tree result;
tree modulus, result;
bool has_side_effects = false;
if (operation_type
@ -647,18 +646,19 @@ build_binary_op (enum tree_code op_code, tree result_type,
&& TYPE_EXTRA_SUBTYPE_P (operation_type))
operation_type = get_base_type (operation_type);
modulus = (operation_type && TREE_CODE (operation_type) == INTEGER_TYPE
modulus = (operation_type
&& TREE_CODE (operation_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (operation_type)
? TYPE_MODULUS (operation_type) : 0);
? TYPE_MODULUS (operation_type) : NULL_TREE);
switch (op_code)
{
case MODIFY_EXPR:
/* If there were any integral or pointer conversions on LHS, remove
/* If there were integral or pointer conversions on the LHS, remove
them; we'll be putting them back below if needed. Likewise for
conversions between array and record types. But don't do this if
the right operand is not BLKmode (for packed arrays)
unless we are not changing the mode. */
conversions between array and record types, except for justified
modular types. But don't do this if the right operand is not
BLKmode (for packed arrays) unless we are not changing the mode. */
while ((TREE_CODE (left_operand) == CONVERT_EXPR
|| TREE_CODE (left_operand) == NOP_EXPR
|| TREE_CODE (left_operand) == VIEW_CONVERT_EXPR)
@ -669,8 +669,6 @@ build_binary_op (enum tree_code op_code, tree result_type,
|| POINTER_TYPE_P (TREE_TYPE
(TREE_OPERAND (left_operand, 0)))))
|| (((TREE_CODE (left_type) == RECORD_TYPE
/* Don't remove conversions to justified modular
types. */
&& !TYPE_JUSTIFIED_MODULAR_P (left_type))
|| TREE_CODE (left_type) == ARRAY_TYPE)
&& ((TREE_CODE (TREE_TYPE
@ -692,8 +690,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
if (!operation_type)
operation_type = left_type;
/* If we are copying one array or record to another, find the best type
to use. */
/* Find the best type to use for copying between aggregate types. */
if (((TREE_CODE (left_type) == ARRAY_TYPE
&& TREE_CODE (right_type) == ARRAY_TYPE)
|| (TREE_CODE (left_type) == RECORD_TYPE
@ -709,11 +706,11 @@ build_binary_op (enum tree_code op_code, tree result_type,
/* Ensure everything on the LHS is valid. If we have a field reference,
strip anything that get_inner_reference can handle. Then remove any
conversions with type types having the same code and mode. Mark
conversions between types having the same code and mode. And mark
VIEW_CONVERT_EXPRs with TREE_ADDRESSABLE. When done, we must have
either an INDIRECT_REF or a decl. */
either an INDIRECT_REF, a NULL_EXPR or a DECL node. */
result = left_operand;
while (1)
while (true)
{
tree restype = TREE_TYPE (result);
@ -744,21 +741,21 @@ build_binary_op (enum tree_code op_code, tree result_type,
}
gcc_assert (TREE_CODE (result) == INDIRECT_REF
|| TREE_CODE (result) == NULL_EXPR || DECL_P (result));
|| TREE_CODE (result) == NULL_EXPR
|| DECL_P (result));
/* Convert the right operand to the operation type unless
it is either already of the correct type or if the type
involves a placeholder, since the RHS may not have the same
record type. */
/* Convert the right operand to the operation type unless it is
either already of the correct type or if the type involves a
placeholder, since the RHS may not have the same record type. */
if (operation_type != right_type
&& (!CONTAINS_PLACEHOLDER_P (TYPE_SIZE (operation_type))))
&& !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (operation_type)))
{
right_operand = convert (operation_type, right_operand);
right_type = operation_type;
}
/* If the left operand is not the same type as the operation type,
surround it in a VIEW_CONVERT_EXPR. */
/* If the left operand is not of the same type as the operation
type, wrap it up in a VIEW_CONVERT_EXPR. */
if (left_type != operation_type)
left_operand = unchecked_convert (operation_type, left_operand, false);
@ -1286,7 +1283,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
tree modulus = ((operation_type
&& TREE_CODE (operation_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (operation_type))
? TYPE_MODULUS (operation_type) : 0);
? TYPE_MODULUS (operation_type) : NULL_TREE);
int mod_pow2 = modulus && integer_pow2p (modulus);
/* If this is a modular type, there are various possibilities