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

trans.c (call_to_gnu): Return an expression with a COMPOUND_EXPR including the call instead of...

Browse Source 
2007-04-06  Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou <botcazou@adacore.com>

	* trans.c (call_to_gnu) <TYPE_RETURNS_BY_TARGET_PTR_P>: Return an
	expression with a COMPOUND_EXPR including the call instead of emitting
	the call directly here.
	(gnat_to_gnu) <N_Slice>: Do not return a non-constant low bound if the
	high bound is constant and the slice is empty.  Tidy.
	(tree_transform, case N_Op_Not): Handle properly the case where the
	operation applies to a private type whose full view is a modular type.
	(Case_Statement_To_gnu): If an alternative is an E_Constant with an
	Address_Clause, use the associated Expression as the GNAT tree
	representing the choice value to ensure the corresponding GCC tree is
	of the proper kind.
	(maybe_stabilize_reference): Stabilize COMPOUND_EXPRs as a whole
	instead of just the operands, as the base GCC stabilize_reference does.
	<CALL_EXPR>: New case. Directly stabilize the call if an lvalue is not
	requested; otherwise fail.
	(addressable_p) <COMPONENT_REF>: Do not test DECL_NONADDRESSABLE_P.

From-SVN: r123608
This commit is contained in:
Olivier Hainque 2007-04-06 11:40:22 +02:00 committed by Arnaud Charlet
parent 4b437c6bb9
commit 3ce5f966ad
1 changed files with 138 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

209
gcc/ada/trans.c
View File

@ -288,7 +288,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
/* Perform initializations for this module. */
void
gnat_init_stmt_group ()
gnat_init_stmt_group (void)
{
/* Initialize ourselves. */
init_code_table ();
@ -1172,8 +1172,7 @@ Case_Statement_to_gnu (Node_Id gnat_node)
case N_Identifier:
case N_Expanded_Name:
/* This represents either a subtype range or a static value of
some kind; Ekind says which. If a static value, fall through
to the next case. */
some kind; Ekind says which. */
if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
{
tree gnu_type = get_unpadded_type (Entity (gnat_choice));
@ -1182,6 +1181,29 @@ Case_Statement_to_gnu (Node_Id gnat_node)
gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
break;
}
/* Static values are handled by the next case to which we'll
fallthrough. If this is a constant with an address clause
attached, we need to get to the initialization expression
first, as the GCC tree for the entity might happen to be an
INDIRECT_REF otherwise. */
else if (Ekind (Entity (gnat_choice)) == E_Constant
&& Present (Address_Clause (Entity (gnat_choice))))
{
/* We might have a deferred constant with an address clause
on either the incomplete or the full view. While the
Address_Clause is always attached to the visible entity,
as tested above, the static value is the Expression
attached to the the declaration of the entity or of its
full view if any. */
Entity_Id gnat_constant = Entity (gnat_choice);
if (Present (Full_View (gnat_constant)))
gnat_constant = Full_View (gnat_constant);
gnat_choice
= Expression (Declaration_Node (gnat_constant));
}
/* ... fall through ... */
@ -1996,14 +2018,43 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
gnu_subprog_addr,
nreverse (gnu_actual_list));
/* If we return by passing a target, we emit the call and return the target
as our result. */
/* If we return by passing a target, the result is the target after the
call. We must not emit the call directly here because this might be
evaluated as part of an expression with conditions to control whether
the call should be emitted or not. */
if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
{
add_stmt_with_node (gnu_subprog_call, gnat_node);
*gnu_result_type_p
/* Conceptually, what we need is a COMPOUND_EXPR with the call followed
by the target object converted to the proper type. Doing so would
potentially be very inefficient, however, as this expresssion might
end up wrapped into an outer SAVE_EXPR later on, which would incur a
pointless temporary copy of the whole object.
What we do instead is build a COMPOUND_EXPR returning the address of
the target, and then dereference. Wrapping the COMPOUND_EXPR into a
SAVE_EXPR later on then only incurs a pointer copy. */
tree gnu_result_type
= TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type)));
return unchecked_convert (*gnu_result_type_p, gnu_target, false);
/* Build and return
(result_type) *[gnu_subprog_call (&gnu_target, ...), &gnu_target] */
tree gnu_target_address
= build_unary_op (ADDR_EXPR, NULL_TREE, gnu_target);
gnu_result
= build2 (COMPOUND_EXPR, TREE_TYPE (gnu_target_address),
gnu_subprog_call, gnu_target_address);
gnu_result
= unchecked_convert (gnu_result_type,
build_unary_op (INDIRECT_REF, NULL_TREE,
gnu_result),
false);
*gnu_result_type_p = gnu_result_type;
return gnu_result;
}
/* If it is a function call, the result is the call expression unless
@ -3032,65 +3083,73 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Slice:
{
tree gnu_type;
Node_Id gnat_range_node = Discrete_Range (gnat_node);
tree gnu_type;
Node_Id gnat_range_node = Discrete_Range (gnat_node);
gnu_result = gnat_to_gnu (Prefix (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = gnat_to_gnu (Prefix (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
/* Do any implicit dereferences of the prefix and do any needed
range check. */
gnu_result = maybe_implicit_deref (gnu_result);
gnu_result = maybe_unconstrained_array (gnu_result);
gnu_type = TREE_TYPE (gnu_result);
if (Do_Range_Check (gnat_range_node))
{
/* Get the bounds of the slice. */
gnu_result = maybe_implicit_deref (gnu_result);
gnu_result = maybe_unconstrained_array (gnu_result);
gnu_type = TREE_TYPE (gnu_result);
if (Do_Range_Check (gnat_range_node))
{
/* Get the bounds of the slice. */
tree gnu_index_type
= TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_result_type));
tree gnu_min_expr = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_max_expr = TYPE_MAX_VALUE (gnu_index_type);
tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
tree gnu_min_expr = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_max_expr = TYPE_MAX_VALUE (gnu_index_type);
/* Get the permitted bounds. */
tree gnu_base_index_type
= TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type));
tree gnu_base_min_expr = TYPE_MIN_VALUE (gnu_base_index_type);
tree gnu_base_max_expr = TYPE_MAX_VALUE (gnu_base_index_type);
tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
/* Check to see that the minimum slice value is in range */
gnu_expr_l
= emit_index_check
(gnu_result, gnu_min_expr,
TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
/* Check to see that the minimum slice value is in range. */
gnu_expr_l = emit_index_check (gnu_result,
gnu_min_expr,
gnu_base_min_expr,
gnu_base_max_expr);
/* Check to see that the maximum slice value is in range */
gnu_expr_h
= emit_index_check
(gnu_result, gnu_max_expr,
TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
/* Check to see that the maximum slice value is in range. */
gnu_expr_h = emit_index_check (gnu_result,
gnu_max_expr,
gnu_base_min_expr,
gnu_base_max_expr);
/* Derive a good type to convert everything too */
gnu_expr_type = get_base_type (TREE_TYPE (gnu_expr_l));
/* Derive a good type to convert everything to. */
gnu_expr_type = get_base_type (TREE_TYPE (gnu_expr_l));
/* Build a compound expression that does the range checks */
gnu_expr
= build_binary_op (COMPOUND_EXPR, gnu_expr_type,
convert (gnu_expr_type, gnu_expr_h),
convert (gnu_expr_type, gnu_expr_l));
/* Build a compound expression that does the range checks and
returns the low bound. */
gnu_expr = build_binary_op (COMPOUND_EXPR, gnu_expr_type,
convert (gnu_expr_type, gnu_expr_h),
convert (gnu_expr_type, gnu_expr_l));
/* Build a conditional expression that returns the range checks
expression if the slice range is not null (max >= min) or
returns the min if the slice range is null */
gnu_expr
= fold_build3 (COND_EXPR, gnu_expr_type,
build_binary_op (GE_EXPR, gnu_expr_type,
convert (gnu_expr_type,
gnu_max_expr),
convert (gnu_expr_type,
gnu_min_expr)),
gnu_expr, gnu_min_expr);
}
else
gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
/* Build a conditional expression that does the range check and
returns the low bound if the slice is not empty (max >= min),
and returns the naked low bound otherwise (max < min), unless
it is non-constant and the high bound is; this prevents VRP
from inferring bogus ranges on the unlikely path. */
gnu_expr = fold_build3 (COND_EXPR, gnu_expr_type,
build_binary_op (GE_EXPR, gnu_expr_type,
convert (gnu_expr_type,
gnu_max_expr),
convert (gnu_expr_type,
gnu_min_expr)),
gnu_expr,
TREE_CODE (gnu_min_expr) != INTEGER_CST
&& TREE_CODE (gnu_max_expr) == INTEGER_CST
? gnu_max_expr : gnu_min_expr);
}
else
/* Simply return the naked low bound. */
gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
gnu_result, gnu_expr);
}
break;
@ -3487,7 +3546,9 @@ gnat_to_gnu (Node_Id gnat_node)
/* This case can apply to a boolean or a modular type.
Fall through for a boolean operand since GNU_CODES is set
up to handle this. */
if (IN (Ekind (Etype (gnat_node)), Modular_Integer_Kind))
if (Is_Modular_Integer_Type (Etype (gnat_node))
|| (Ekind (Etype (gnat_node)) == E_Private_Type
&& Is_Modular_Integer_Type (Full_View (Etype (gnat_node)))))
{
gnu_expr = gnat_to_gnu (Right_Opnd (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
@ -4473,7 +4534,7 @@ insert_code_for (Node_Id gnat_node)
/* Start a new statement group chained to the previous group. */
static void
start_stmt_group ()
start_stmt_group (void)
{
struct stmt_group *group = stmt_group_free_list;
@ -4633,7 +4694,7 @@ set_block_for_group (tree gnu_block)
BLOCK or cleanups were set. */
static tree
end_stmt_group ()
end_stmt_group (void)
{
struct stmt_group *group = current_stmt_group;
tree gnu_retval = group->stmt_list;
@ -5633,12 +5694,12 @@ addressable_p (tree gnu_expr)
case COMPONENT_REF:
return (!DECL_BIT_FIELD (TREE_OPERAND (gnu_expr, 1))
&& (!STRICT_ALIGNMENT
/* If the field was marked as "semantically" addressable
in create_field_decl, we are guaranteed that it can
be directly addressed. */
|| !DECL_NONADDRESSABLE_P (TREE_OPERAND (gnu_expr, 1))
/* Otherwise it can nevertheless be directly addressed
if it has been sufficiently aligned in the record. */
/* Even with DECL_BIT_FIELD cleared, we have to ensure that
the field is sufficiently aligned, in case it is subject
to a pragma Component_Alignment. But we don't need to
check the alignment of the containing record, as it is
guaranteed to be not smaller than that of its most
aligned field that is not a bit-field. */
|| DECL_ALIGN (TREE_OPERAND (gnu_expr, 1))
>= TYPE_ALIGN (TREE_TYPE (gnu_expr)))
&& addressable_p (TREE_OPERAND (gnu_expr, 0)));
@ -6004,8 +6065,8 @@ maybe_stabilize_reference (tree ref, bool force, bool lvalues_only,
case ADDR_EXPR:
/* A standalone ADDR_EXPR is never an lvalue, and this one can't
be nested inside an outer INDIRECT_REF, since INDIREC_REF goes
straight to stabilize_1. */
be nested inside an outer INDIRECT_REF, since INDIRECT_REF goes
straight to gnat_stabilize_reference_1. */
if (lvalues_only)
goto failure;
@ -6057,11 +6118,17 @@ maybe_stabilize_reference (tree ref, bool force, bool lvalues_only,
break;
case COMPOUND_EXPR:
result = build2 (COMPOUND_EXPR, type,
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
force),
maybe_stabilize_reference (TREE_OPERAND (ref, 1), force,
lvalues_only, success));
result = gnat_stabilize_reference_1 (ref, force);
break;
case CALL_EXPR:
if (lvalues_only)
goto failure;
/* This generates better code than the scheme in protect_multiple_eval
because large objects will be returned via invisible reference in
most ABIs so the temporary will directly be filled by the callee. */
result = gnat_stabilize_reference_1 (ref, force);
break;
case ERROR_MARK: