From db3914fdce46743eb7ace2e6cbacfaf72f32a14f Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Mon, 12 Apr 2010 08:54:00 +0000 Subject: [PATCH] * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable. (call_to_gnu): Test gigi's flag TYPE_BY_REFERENCE_P instead of calling front-end's predicate Is_By_Reference_Type. Use consistent order and remove ??? comment. Use original conversion in all cases, if any. * gcc-interface/utils.c (make_dummy_type): Minor tweak. (convert): Use local copy in more cases. : Remove deactivated code. (unchecked_convert): Use a couple of local copies. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158216 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 11 +++++ gcc/ada/gcc-interface/trans.c | 95 ++++++++++++++++++------------------------- gcc/ada/gcc-interface/utils.c | 72 +++++++++++--------------------- 3 files changed, 75 insertions(+), 103 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 55898e3e4a5..22a68c4cc89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2010-04-12 Eric Botcazou + + * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable. + (call_to_gnu): Test gigi's flag TYPE_BY_REFERENCE_P instead of calling + front-end's predicate Is_By_Reference_Type. Use consistent order and + remove ??? comment. Use original conversion in all cases, if any. + * gcc-interface/utils.c (make_dummy_type): Minor tweak. + (convert): Use local copy in more cases. + : Remove deactivated code. + (unchecked_convert): Use a couple of local copies. + 2010-04-11 Eric Botcazou * gcc-interface/trans.c (lvalue_required_for_attribute_p): New static diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 28a2bd414bd..42e07b5d170 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -997,18 +997,17 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) && DECL_P (gnu_result) && DECL_INITIAL (gnu_result)) { - tree object - = (TREE_CODE (gnu_result) == CONST_DECL - ? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result); + bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL + && !DECL_CONST_CORRESPONDING_VAR (gnu_result)); - /* If there is a corresponding variable, we only want to return - the CST value if an lvalue is not required. Evaluate this + /* If there is a (corresponding) variable, we only want to return + the constant value if an lvalue is not required. Evaluate this now if we have not already done so. */ - if (object && require_lvalue < 0) + if (!constant_only && require_lvalue < 0) require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true, Is_Aliased (gnat_temp)); - if (!object || !require_lvalue) + if (constant_only || !require_lvalue) gnu_result = unshare_expr (DECL_INITIAL (gnu_result)); } @@ -2500,14 +2499,14 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) tree gnu_formal = present_gnu_tree (gnat_formal) ? get_gnu_tree (gnat_formal) : NULL_TREE; tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal)); - /* We must suppress conversions that can cause the creation of a - temporary in the Out or In Out case because we need the real - object in this case, either to pass its address if it's passed - by reference or as target of the back copy done after the call - if it uses the copy-in copy-out mechanism. We do it in the In - case too, except for an unchecked conversion because it alone - can cause the actual to be misaligned and the addressability - test is applied to the real object. */ + /* In the Out or In Out case, we must suppress conversions that yield + an lvalue but can nevertheless cause the creation of a temporary, + because we need the real object in this case, either to pass its + address if it's passed by reference or as target of the back copy + done after the call if it uses the copy-in copy-out mechanism. + We do it in the In case too, except for an unchecked conversion + because it alone can cause the actual to be misaligned and the + addressability test is applied to the real object. */ bool suppress_type_conversion = ((Nkind (gnat_actual) == N_Unchecked_Type_Conversion && Ekind (gnat_formal) != E_In_Parameter) @@ -2539,8 +2538,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) { tree gnu_copy = gnu_name; - /* If the type is by_reference, a copy is not allowed. */ - if (Is_By_Reference_Type (Etype (gnat_formal))) + /* If the type is passed by reference, a copy is not allowed. */ + if (AGGREGATE_TYPE_P (gnu_formal_type) + && TYPE_BY_REFERENCE_P (gnu_formal_type)) post_error ("misaligned actual cannot be passed by reference", gnat_actual); @@ -2610,44 +2610,29 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) So do it here for the part we will use as an input, if any. */ if (Ekind (gnat_formal) != E_Out_Parameter && TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual))) - gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)), - gnu_actual); - - /* Do any needed conversions for the actual and make sure that it is - in range of the formal's type. */ - if (suppress_type_conversion) - { - /* Put back the conversion we suppressed above in the computation - of the real object. Note that we treat a conversion between - aggregate types as if it is an unchecked conversion here. */ - gnu_actual - = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)), - gnu_actual, - (Nkind (gnat_actual) - == N_Unchecked_Type_Conversion) - && No_Truncation (gnat_actual)); - - if (Ekind (gnat_formal) != E_Out_Parameter - && Do_Range_Check (gnat_actual)) - gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal), - gnat_actual); - } + gnu_actual + = convert (get_unpadded_type (Etype (gnat_actual)), gnu_actual); + + /* Put back the conversion we suppressed above in the computation of the + real object. And even if we didn't suppress any conversion there, we + may have suppressed a conversion to the Etype of the actual earlier, + since the parent is a procedure call, so put it back here. */ + if (suppress_type_conversion + && Nkind (gnat_actual) == N_Unchecked_Type_Conversion) + gnu_actual + = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)), + gnu_actual, No_Truncation (gnat_actual)); else - { - if (Ekind (gnat_formal) != E_Out_Parameter - && Do_Range_Check (gnat_actual)) - gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal), - gnat_actual); - - /* We may have suppressed a conversion to the Etype of the actual - since the parent is a procedure call. So put it back here. - ??? We use the reverse order compared to the case above because - of an awkward interaction with the check. */ - if (TREE_CODE (gnu_actual) != SAVE_EXPR) - gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)), - gnu_actual); - } + gnu_actual + = convert (gnat_to_gnu_type (Etype (gnat_actual)), gnu_actual); + + /* Make sure that the actual is in range of the formal's type. */ + if (Ekind (gnat_formal) != E_Out_Parameter + && Do_Range_Check (gnat_actual)) + gnu_actual + = emit_range_check (gnu_actual, Etype (gnat_formal), gnat_actual); + /* And convert it to this type. */ if (TREE_CODE (gnu_actual) != SAVE_EXPR) gnu_actual = convert (gnu_formal_type, gnu_actual); @@ -2657,8 +2642,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) && TREE_CODE (gnu_name) == CONSTRUCTOR && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name))) - gnu_name = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), - gnu_name); + gnu_name + = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), gnu_name); /* If we have not saved a GCC object for the formal, it means it is an Out parameter not passed by reference and that need not be copied in. diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index fed723fa929..cf0ff60b485 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -294,8 +294,8 @@ make_dummy_type (Entity_Id gnat_type) TYPE_DUMMY_P (gnu_type) = 1; TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type); - if (AGGREGATE_TYPE_P (gnu_type)) - TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type); + if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_type)) + TYPE_BY_REFERENCE_P (gnu_type) = 1; SET_DUMMY_NODE (gnat_underlying, gnu_type); @@ -3656,12 +3656,12 @@ convert_to_thin_pointer (tree type, tree expr) tree convert (tree type, tree expr) { - enum tree_code code = TREE_CODE (type); tree etype = TREE_TYPE (expr); enum tree_code ecode = TREE_CODE (etype); + enum tree_code code = TREE_CODE (type); - /* If EXPR is already the right type, we are done. */ - if (type == etype) + /* If the expression is already of the right type, we are done. */ + if (etype == type) return expr; /* If both input and output have padding and are of variable size, do this @@ -3708,7 +3708,7 @@ convert (tree type, tree expr) /* If the inner type is of self-referential size and the expression type is a record, do this as an unchecked conversion. But first pad the expression if possible to have the same size on both sides. */ - if (TREE_CODE (etype) == RECORD_TYPE + if (ecode == RECORD_TYPE && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) { if (TREE_CONSTANT (TYPE_SIZE (etype))) @@ -3721,7 +3721,7 @@ convert (tree type, tree expr) final conversion as an unchecked conversion, again to avoid the need for some variable-sized temporaries. If valid, this conversion is very likely purely technical and without real effects. */ - if (TREE_CODE (etype) == ARRAY_TYPE + if (ecode == ARRAY_TYPE && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE && !TREE_CONSTANT (TYPE_SIZE (etype)) && !TREE_CONSTANT (TYPE_SIZE (type))) @@ -4000,25 +4000,6 @@ convert (tree type, tree expr) } break; - case INDIRECT_REF: - /* If both types are record types, just convert the pointer and - make a new INDIRECT_REF. - - ??? Disable this for now since it causes problems with the - code in build_binary_op for MODIFY_EXPR which wants to - strip off conversions. But that code really is a mess and - we need to do this a much better way some time. */ - if (0 - && (TREE_CODE (type) == RECORD_TYPE - || TREE_CODE (type) == UNION_TYPE) - && (TREE_CODE (etype) == RECORD_TYPE - || TREE_CODE (etype) == UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype)) - return build_unary_op (INDIRECT_REF, NULL_TREE, - convert (build_pointer_type (type), - TREE_OPERAND (expr, 0))); - break; - default: break; } @@ -4359,29 +4340,26 @@ tree unchecked_convert (tree type, tree expr, bool notrunc_p) { tree etype = TREE_TYPE (expr); + enum tree_code ecode = TREE_CODE (etype); + enum tree_code code = TREE_CODE (type); - /* If the expression is already the right type, we are done. */ + /* If the expression is already of the right type, we are done. */ if (etype == type) return expr; /* If both types types are integral just do a normal conversion. Likewise for a conversion to an unconstrained array. */ if ((((INTEGRAL_TYPE_P (type) - && !(TREE_CODE (type) == INTEGER_TYPE - && TYPE_VAX_FLOATING_POINT_P (type))) + && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type))) || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type)) - || (TREE_CODE (type) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (type))) + || (code == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (type))) && ((INTEGRAL_TYPE_P (etype) - && !(TREE_CODE (etype) == INTEGER_TYPE - && TYPE_VAX_FLOATING_POINT_P (etype))) + && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype))) || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype)) - || (TREE_CODE (etype) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (etype)))) - || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)))) + || code == UNCONSTRAINED_ARRAY_TYPE) { - if (TREE_CODE (etype) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (etype)) + if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)) { tree ntype = copy_type (etype); TYPE_BIASED_REPRESENTATION_P (ntype) = 0; @@ -4389,8 +4367,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = build1 (NOP_EXPR, ntype, expr); } - if (TREE_CODE (type) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (type)) + if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) { tree rtype = copy_type (type); TYPE_BIASED_REPRESENTATION_P (rtype) = 0; @@ -4441,8 +4418,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* We have a special case when we are converting between two unconstrained array types. In that case, take the address, convert the fat pointer types, and dereference. */ - else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE - && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + else if (ecode == code && code == UNCONSTRAINED_ARRAY_TYPE) expr = build_unary_op (INDIRECT_REF, NULL_TREE, build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type), build_unary_op (ADDR_EXPR, NULL_TREE, @@ -4450,8 +4426,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* Another special case is when we are converting to a vector type from its representative array type; this a regular conversion. */ - else if (TREE_CODE (type) == VECTOR_TYPE - && TREE_CODE (etype) == ARRAY_TYPE + else if (code == VECTOR_TYPE + && ecode == ARRAY_TYPE && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type), etype)) expr = convert (type, expr); @@ -4460,6 +4436,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) { expr = maybe_unconstrained_array (expr); etype = TREE_TYPE (expr); + ecode = TREE_CODE (etype); if (can_fold_for_view_convert_p (expr)) expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr); else @@ -4472,8 +4449,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) is a biased type or if both the input and output are unsigned. */ if (!notrunc_p && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) - && !(TREE_CODE (type) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (type)) + && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) && 0 != compare_tree_int (TYPE_RM_SIZE (type), GET_MODE_BITSIZE (TYPE_MODE (type))) && !(INTEGRAL_TYPE_P (etype) @@ -4484,8 +4460,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) 0)) && !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype))) { - tree base_type = gnat_type_for_mode (TYPE_MODE (type), - TYPE_UNSIGNED (type)); + tree base_type + = gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type)); tree shift_expr = convert (base_type, size_binop (MINUS_EXPR, -- 2.11.0