From: Olivier Hainque Date: Fri, 6 Apr 2007 09:40:22 +0000 (+0200) Subject: trans.c (call_to_gnu): Return an expression with a COMPOUND_EXPR including the call... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3ce5f966ad256483220ae2d3ecbe9b0e1383fabd;p=gcc.git trans.c (call_to_gnu): Return an expression with a COMPOUND_EXPR including the call instead of... 2007-04-06 Olivier Hainque Eric Botcazou * trans.c (call_to_gnu) : Return an expression with a COMPOUND_EXPR including the call instead of emitting the call directly here. (gnat_to_gnu) : 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. : New case. Directly stabilize the call if an lvalue is not requested; otherwise fail. (addressable_p) : Do not test DECL_NONADDRESSABLE_P. From-SVN: r123608 --- diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 230dccf2ea5..5f75aa6db14 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -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; - - /* 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 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)))); - - /* Derive a good type to convert everything too */ - 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 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)); + 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, + 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, + gnu_base_min_expr, + gnu_base_max_expr); + + /* 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 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 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: