diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
-rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 5 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.cc | 43 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/misc.cc | 1 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 103 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils.cc | 5 |
6 files changed, 66 insertions, 93 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index ec52024..6d9639d 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -97,11 +97,6 @@ do { \ an Ada array other than the first. */ #define TYPE_MULTI_ARRAY_P(NODE) TYPE_LANG_FLAG_1 (ARRAY_TYPE_CHECK (NODE)) -/* For FUNCTION_TYPE and METHOD_TYPE, nonzero if function returns an - unconstrained array or record type. */ -#define TYPE_RETURN_UNCONSTRAINED_P(NODE) \ - TYPE_LANG_FLAG_1 (FUNC_OR_METHOD_CHECK (NODE)) - /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes a justified modular type (will only be true for RECORD_TYPE). */ #define TYPE_JUSTIFIED_MODULAR_P(NODE) \ diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 318c3be..bbbb343 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -5807,7 +5807,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, bool pure_flag = Is_Pure (gnat_subprog); bool return_by_direct_ref_p = false; bool return_by_invisi_ref_p = false; - bool return_unconstrained_p = false; bool incomplete_profile_p = false; int num; @@ -5822,7 +5821,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_type))) { gnu_return_type = TREE_TYPE (gnu_type); - return_unconstrained_p = TYPE_RETURN_UNCONSTRAINED_P (gnu_type); return_by_direct_ref_p = TYPE_RETURN_BY_DIRECT_REF_P (gnu_type); return_by_invisi_ref_p = TREE_ADDRESSABLE (gnu_type); } @@ -5838,38 +5836,16 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, else gnu_return_type = gnat_to_gnu_profile_type (gnat_return_type); - /* If this function returns by reference, make the actual return type - the reference type and make a note of that. */ - if (Returns_By_Ref (gnat_subprog)) + /* If this function returns by reference or on the secondary stack, make + the actual return type the reference type and make a note of that. */ + if (Returns_By_Ref (gnat_subprog) + || Needs_Secondary_Stack (gnat_return_type) + || Is_Secondary_Stack_Thunk (gnat_subprog)) { gnu_return_type = build_reference_type (gnu_return_type); return_by_direct_ref_p = true; } - /* If the return type is an unconstrained array type, the return value - will be allocated on the secondary stack so the actual return type - is the fat pointer type. */ - else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE) - { - gnu_return_type = TYPE_REFERENCE_TO (gnu_return_type); - return_unconstrained_p = true; - } - - /* This is the same unconstrained array case, but for a dummy type. */ - else if (TYPE_REFERENCE_TO (gnu_return_type) - && TYPE_IS_FAT_POINTER_P (TYPE_REFERENCE_TO (gnu_return_type))) - { - gnu_return_type = TYPE_REFERENCE_TO (gnu_return_type); - return_unconstrained_p = true; - } - - /* This is for the other types returned on the secondary stack. */ - else if (Needs_Secondary_Stack (gnat_return_type)) - { - gnu_return_type = build_reference_type (gnu_return_type); - return_unconstrained_p = true; - } - /* If the Mechanism is By_Reference, ensure this function uses the target's by-invisible-reference mechanism, which may not be the same as above (e.g. it might be passing an extra parameter). */ @@ -5949,8 +5925,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, } if (kind == E_Function) - Set_Mechanism (gnat_subprog, return_unconstrained_p - || return_by_direct_ref_p + Set_Mechanism (gnat_subprog, return_by_direct_ref_p || return_by_invisi_ref_p ? By_Reference : By_Copy); } @@ -5962,7 +5937,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, Similarly, if the function returns an unconstrained type, then the function will allocate the return value on the secondary stack and thus calls to it cannot be CSE'ed, lest the stack be reclaimed. */ - if (VOID_TYPE_P (gnu_return_type) || return_unconstrained_p) + if (VOID_TYPE_P (gnu_return_type) || return_by_direct_ref_p) pure_flag = false; /* Loop over the parameters and get their associated GCC tree. While doing @@ -6250,7 +6225,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, gnu_type = make_node (method_p ? METHOD_TYPE : FUNCTION_TYPE); TREE_TYPE (gnu_type) = gnu_return_type; TYPE_ARG_TYPES (gnu_type) = gnu_param_type_list; - TYPE_RETURN_UNCONSTRAINED_P (gnu_type) = return_unconstrained_p; TYPE_RETURN_BY_DIRECT_REF_P (gnu_type) = return_by_direct_ref_p; TREE_ADDRESSABLE (gnu_type) = return_by_invisi_ref_p; } @@ -6267,7 +6241,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, = TYPE_MAIN_VARIANT (gnu_basetype); } TYPE_CI_CO_LIST (gnu_type) = gnu_cico_list; - TYPE_RETURN_UNCONSTRAINED_P (gnu_type) = return_unconstrained_p; TYPE_RETURN_BY_DIRECT_REF_P (gnu_type) = return_by_direct_ref_p; TREE_ADDRESSABLE (gnu_type) = return_by_invisi_ref_p; TYPE_CANONICAL (gnu_type) = gnu_type; @@ -6289,13 +6262,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, /* GNU_TYPE may be shared since GCC hashes types. Unshare it if it has a different TYPE_CI_CO_LIST or flags. */ if (!fntype_same_flags_p (gnu_type, gnu_cico_list, - return_unconstrained_p, return_by_direct_ref_p, return_by_invisi_ref_p)) { gnu_type = copy_type (gnu_type); TYPE_CI_CO_LIST (gnu_type) = gnu_cico_list; - TYPE_RETURN_UNCONSTRAINED_P (gnu_type) = return_unconstrained_p; TYPE_RETURN_BY_DIRECT_REF_P (gnu_type) = return_by_direct_ref_p; TREE_ADDRESSABLE (gnu_type) = return_by_invisi_ref_p; } diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index bd559d1..6d70c30 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -547,7 +547,7 @@ extern int gnat_types_compatible_p (tree t1, tree t2); extern bool gnat_useless_type_conversion (tree expr); /* Return true if T, a {FUNCTION,METHOD}_TYPE, has the specified flags. */ -extern bool fntype_same_flags_p (const_tree, tree, bool, bool, bool); +extern bool fntype_same_flags_p (const_tree, tree, bool, bool); /* Create an expression whose value is that of EXPR, converted to type TYPE. The TREE_TYPE of the value diff --git a/gcc/ada/gcc-interface/misc.cc b/gcc/ada/gcc-interface/misc.cc index 2caa83f..7824ebf 100644 --- a/gcc/ada/gcc-interface/misc.cc +++ b/gcc/ada/gcc-interface/misc.cc @@ -684,7 +684,6 @@ gnat_type_hash_eq (const_tree t1, const_tree t2) { gcc_assert (FUNC_OR_METHOD_TYPE_P (t1) && TREE_CODE (t1) == TREE_CODE (t2)); return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2), - TYPE_RETURN_UNCONSTRAINED_P (t2), TYPE_RETURN_BY_DIRECT_REF_P (t2), TREE_ADDRESSABLE (t2)); } diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index e80200e..8097a89 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -3725,7 +3725,7 @@ finalize_nrv (tree fndecl, bitmap nrv, vec<tree, va_gc> *other, Node_Id gnat_ret data.result = DECL_RESULT (fndecl); data.gnat_ret = gnat_ret; data.visited = new hash_set<tree>; - if (TYPE_RETURN_UNCONSTRAINED_P (TREE_TYPE (fndecl))) + if (TYPE_RETURN_BY_DIRECT_REF_P (TREE_TYPE (fndecl))) func = finalize_nrv_unc_r; else func = finalize_nrv_r; @@ -3902,6 +3902,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* Try to create a bona-fide thunk and hand it over to the middle-end. */ if (Is_Thunk (gnat_subprog) + && !Is_Secondary_Stack_Thunk (gnat_subprog) && maybe_make_gnu_thunk (gnat_subprog, gnu_subprog)) return; @@ -5252,10 +5253,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_result_type = TREE_TYPE (gnu_call); } - /* If the function returns an unconstrained array or by direct reference, - we have to dereference the pointer. */ - if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type) - || TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)) + /* If the function returns by direct reference, we have to dereference + the pointer. */ + if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)) gnu_call = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_call); if (gnu_target) @@ -7439,52 +7439,58 @@ gnat_to_gnu (Node_Id gnat_node) gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0); /* If the function returns by direct reference, return a pointer - to the return value. */ - if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type) - || By_Ref (gnat_node)) - gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val); - - /* Otherwise, if it returns an unconstrained array, we have to - allocate a new version of the result and return it. */ - else if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type)) + to the return value, possibly after allocating it. */ + if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)) { - gnu_ret_val = maybe_unconstrained_array (gnu_ret_val); - - /* And find out whether this is a candidate for Named Return - Value. If so, record it. */ - if (optimize - && !optimize_debug - && !TYPE_CI_CO_LIST (gnu_subprog_type)) + if (Present (Storage_Pool (gnat_node))) { - tree ret_val = gnu_ret_val; - - /* Strip useless conversions around the return value. */ - if (gnat_useless_type_conversion (ret_val)) - ret_val = TREE_OPERAND (ret_val, 0); - - /* Strip unpadding around the return value. */ - if (TREE_CODE (ret_val) == COMPONENT_REF - && TYPE_IS_PADDING_P - (TREE_TYPE (TREE_OPERAND (ret_val, 0)))) - ret_val = TREE_OPERAND (ret_val, 0); - - /* Now apply the test to the return value. */ - if (return_value_ok_for_nrv_p (NULL_TREE, ret_val)) + gnu_ret_val = maybe_unconstrained_array (gnu_ret_val); + + /* And find out whether it is a candidate for Named Return + Value. If so, record it. Note that we disable this NRV + optimization when we're preserving the control flow as + it entails hoisting the allocation done below. */ + if (optimize + && !optimize_debug + && !TYPE_CI_CO_LIST (gnu_subprog_type)) { - if (!f_named_ret_val) - f_named_ret_val = BITMAP_GGC_ALLOC (); - bitmap_set_bit (f_named_ret_val, DECL_UID (ret_val)); - if (!f_gnat_ret) - f_gnat_ret = gnat_node; + tree ret_val = gnu_ret_val; + + /* Strip conversions around the return value. */ + if (gnat_useless_type_conversion (ret_val)) + ret_val = TREE_OPERAND (ret_val, 0); + + /* Strip unpadding around the return value. */ + if (TREE_CODE (ret_val) == COMPONENT_REF + && TYPE_IS_PADDING_P + (TREE_TYPE (TREE_OPERAND (ret_val, 0)))) + ret_val = TREE_OPERAND (ret_val, 0); + + /* Now apply the test to the return value. */ + if (return_value_ok_for_nrv_p (NULL_TREE, ret_val)) + { + if (!f_named_ret_val) + f_named_ret_val = BITMAP_GGC_ALLOC (); + bitmap_set_bit (f_named_ret_val, + DECL_UID (ret_val)); + if (!f_gnat_ret) + f_gnat_ret = gnat_node; + } } + + gnu_ret_val + = build_allocator (TREE_TYPE (gnu_ret_val), + gnu_ret_val, + TREE_TYPE (gnu_ret_obj), + Procedure_To_Call (gnat_node), + Storage_Pool (gnat_node), + gnat_node, + false); } - gnu_ret_val = build_allocator (TREE_TYPE (gnu_ret_val), - gnu_ret_val, - TREE_TYPE (gnu_ret_obj), - Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), - gnat_node, false); + else + gnu_ret_val + = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val); } /* Otherwise, if it returns by invisible reference, dereference @@ -10670,7 +10676,8 @@ make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk) static bool maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) { - const Entity_Id gnat_target = Thunk_Entity (gnat_thunk); + /* We use the Thunk_Target to compute the properties of the thunk. */ + const Entity_Id gnat_target = Thunk_Target (gnat_thunk); /* Check that the first formal of the target is the only controlling one. */ Entity_Id gnat_formal = First_Formal (gnat_target); @@ -10738,7 +10745,9 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) indirect_offset = (HOST_WIDE_INT) (POINTER_SIZE / BITS_PER_UNIT); } - tree gnu_target = gnat_to_gnu_entity (gnat_target, NULL_TREE, false); + /* But we generate a call to the Thunk_Entity in the thunk. */ + tree gnu_target + = gnat_to_gnu_entity (Thunk_Entity (gnat_thunk), NULL_TREE, false); /* If the target is local, then thunk and target must have the same context because cgraph_node::expand_thunk can only forward the static chain. */ diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index c583aca..3aa810b 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -3841,11 +3841,10 @@ gnat_useless_type_conversion (tree expr) /* Return true if T, a {FUNCTION,METHOD}_TYPE, has the specified flags. */ bool -fntype_same_flags_p (const_tree t, tree cico_list, bool return_unconstrained_p, - bool return_by_direct_ref_p, bool return_by_invisi_ref_p) +fntype_same_flags_p (const_tree t, tree cico_list, bool return_by_direct_ref_p, + bool return_by_invisi_ref_p) { return TYPE_CI_CO_LIST (t) == cico_list - && TYPE_RETURN_UNCONSTRAINED_P (t) == return_unconstrained_p && TYPE_RETURN_BY_DIRECT_REF_P (t) == return_by_direct_ref_p && TREE_ADDRESSABLE (t) == return_by_invisi_ref_p; } |