From 7414a3c340282ab3f7041dfa40ebc52c5f7156ef Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 6 Jun 2016 09:08:56 +0000 Subject: [PATCH] gigi.h (finish_subprog_decl): Add ASM_NAME parameter. * gcc-interface/gigi.h (finish_subprog_decl): Add ASM_NAME parameter. * gcc-interface/decl.c (gnu_ext_name_for_subprog): New function. (gnat_to_gnu_entity) : Do not check compatibility of profiles for builtins here... Call gnu_ext_name_for_subprog. Also update profiles if pointers to limited_with'ed types are updated. (gnat_to_gnu_param): Restore the correct source location information for vector ABI warnings. (associate_subprog_with_dummy_type): Add comment about AI05-019. Set TYPE_DUMMY_IN_PROFILE_P flag unconditionally. (update_profile): Deal with builtin declarations. Call gnu_ext_name_for_subprog. Adjust call to finish_subprog_decl. (update_profiles_with): Add comment. (gnat_to_gnu_subprog_type): Reuse the return type if it is complete. Likewise for parameter declarations in most cases. Do not change the return type for the CICO mechanism if the profile is incomplete. ...but here instead. Always reset the slot for the parameters. * gcc-interface/utils.c (create_subprog_decl): Call gnu_ext_name_for_subprog. Do not set the assembler name here but... (finish_subprog_decl): ...but here instead. Add ASM_NAME parameter. From-SVN: r237119 --- gcc/ada/ChangeLog | 23 +++ gcc/ada/gcc-interface/decl.c | 355 ++++++++++++++++++++++------------ gcc/ada/gcc-interface/gigi.h | 6 +- gcc/ada/gcc-interface/utils.c | 46 ++--- 4 files changed, 279 insertions(+), 151 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 12a2483b43d..19078b9982c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2016-06-06 Eric Botcazou + + * gcc-interface/gigi.h (finish_subprog_decl): Add ASM_NAME parameter. + * gcc-interface/decl.c (gnu_ext_name_for_subprog): New function. + (gnat_to_gnu_entity) : Do not check compatibility + of profiles for builtins here... Call gnu_ext_name_for_subprog. + Also update profiles if pointers to limited_with'ed types are + updated. + (gnat_to_gnu_param): Restore the correct source location information + for vector ABI warnings. + (associate_subprog_with_dummy_type): Add comment about AI05-019. + Set TYPE_DUMMY_IN_PROFILE_P flag unconditionally. + (update_profile): Deal with builtin declarations. + Call gnu_ext_name_for_subprog. Adjust call to finish_subprog_decl. + (update_profiles_with): Add comment. + (gnat_to_gnu_subprog_type): Reuse the return type if it is complete. + Likewise for parameter declarations in most cases. Do not change + the return type for the CICO mechanism if the profile is incomplete. + ...but here instead. Always reset the slot for the parameters. + * gcc-interface/utils.c (create_subprog_decl): Call + gnu_ext_name_for_subprog. Do not set the assembler name here but... + (finish_subprog_decl): ...but here instead. Add ASM_NAME parameter. + 2016-06-06 Eric Botcazou * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Insert the diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6b6bc07684d..c0100addd26 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -204,6 +204,7 @@ static tree elaborate_reference (tree, Entity_Id, bool, tree *); static tree gnat_to_gnu_component_type (Entity_Id, bool, bool); static tree gnat_to_gnu_subprog_type (Entity_Id, bool, bool, tree *); static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool); +static tree gnu_ext_name_for_subprog (Entity_Id, tree); static tree change_qualified_type (tree, int); static bool same_discriminant_p (Entity_Id, Entity_Id); static bool array_type_has_nonaliased_component (tree, Entity_Id); @@ -4109,7 +4110,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) case E_Function: case E_Procedure: { - tree gnu_ext_name = create_concat_name (gnat_entity, NULL); + tree gnu_ext_name + = gnu_ext_name_for_subprog (gnat_entity, gnu_entity_name); enum inline_status_t inline_status = Has_Pragma_No_Inline (gnat_entity) ? is_suppressed @@ -4191,49 +4193,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gnu_type = gnat_to_gnu_subprog_type (gnat_entity, definition, debug_info_p, &gnu_param_list); - - /* If this subprogram is expectedly bound to a GCC builtin, fetch the - corresponding DECL node and check the parameter association. */ - if (Convention (gnat_entity) == Convention_Intrinsic - && Present (Interface_Name (gnat_entity))) + if (DECL_P (gnu_type)) { - tree gnu_builtin_decl = builtin_decl_for (gnu_ext_name); - - /* If we have a builtin DECL for that function, use it. Check if - the profiles are compatible and warn if they are not. Note that - the checker is expected to post diagnostics in this case. */ - if (gnu_builtin_decl) - { - intrin_binding_t inb - = { gnat_entity, gnu_type, TREE_TYPE (gnu_builtin_decl) }; - - if (!intrin_profiles_compatible_p (&inb)) - post_error - ("?profile of& doesn''t match the builtin it binds!", - gnat_entity); - - gnu_decl = gnu_builtin_decl; - gnu_type = TREE_TYPE (gnu_builtin_decl); - break; - } - - /* Inability to find the builtin DECL most often indicates a - genuine mistake, but imports of unregistered intrinsics are - sometimes issued on purpose to allow hooking in alternate - bodies. We post a warning conditioned on Wshadow in this case, - to let developers be notified on demand without risking false - positives with common default sets of options. */ - else if (warn_shadow) - post_error ("?gcc intrinsic not found for&!", gnat_entity); + gnu_decl = gnu_type; + gnu_type = TREE_TYPE (gnu_decl); + break; } - /* If there was no specified Interface_Name and the external and - internal names of the subprogram are the same, only use the - internal name to allow disambiguation of nested subprograms. */ - if (No (Interface_Name (gnat_entity)) - && gnu_ext_name == gnu_entity_name) - gnu_ext_name = NULL_TREE; - /* Deal with platform-specific calling conventions. */ if (Has_Stdcall_Convention (gnat_entity)) prepend_one_attribute @@ -5008,6 +4974,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { update_pointer_to (TYPE_MAIN_VARIANT (p->old_type), TREE_TYPE (gnu_decl)); + if (TYPE_DUMMY_IN_PROFILE_P (p->old_type)) + update_profiles_with (p->old_type); p->old_type = NULL_TREE; } } @@ -5321,8 +5289,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, bool first, Entity_Id gnat_subprog, bool by_return = false, by_component_ptr = false; bool by_ref = false; bool restricted_aliasing_p = false; + location_t saved_location = input_location; tree gnu_param; + /* Make sure to use the proper SLOC for vector ABI warnings. */ + if (VECTOR_TYPE_P (gnu_param_type)) + Sloc_to_locus (Sloc (gnat_subprog), &input_location); + /* Builtins are expanded inline and there is no real call sequence involved. So the type expected by the underlying expander is always the type of the argument "as is". */ @@ -5454,6 +5427,8 @@ gnat_to_gnu_param (Entity_Id gnat_param, bool first, Entity_Id gnat_subprog, else if (!in_param) *cico = true; + input_location = saved_location; + if (mech == By_Copy && (by_ref || by_component_ptr)) post_error ("?cannot pass & by copy", gnat_param); @@ -5507,7 +5482,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, bool first, Entity_Id gnat_subprog, } /* Associate GNAT_SUBPROG with GNU_TYPE, which must be a dummy type, so that - GNAT_SUBPROG is updated when TYPE is completed. */ + GNAT_SUBPROG is updated when TYPE is completed. + + Ada 2012 (AI05-019) says that freezing a subprogram does not always freeze + the corresponding profile, which means that, by the time the freeze node + of the subprogram is encountered, types involved in its profile may still + be not frozen yet. That's why we do not update GNAT_SUBPROG when we see + its freeze node but only when we see the freeze node of types involved in + its profile, either types of formal parameters or the return type. */ static void associate_subprog_with_dummy_type (Entity_Id gnat_subprog, tree gnu_type) @@ -5524,8 +5506,15 @@ associate_subprog_with_dummy_type (Entity_Id gnat_subprog, tree gnu_type) e->base.from = gnu_type; e->to = NULL; *slot = e; - TYPE_DUMMY_IN_PROFILE_P (gnu_type) = 1; } + + /* Even if there is already a slot for GNU_TYPE, we need to set the flag + because the vector might have been just emptied by update_profiles_with. + This can happen when there are 2 freeze nodes associated with different + views of the same type; the type will be really complete only after the + second freeze node is encountered. */ + TYPE_DUMMY_IN_PROFILE_P (gnu_type) = 1; + vec *v = (*slot)->to; /* Make sure GNAT_SUBPROG is not associated twice with the same dummy type, @@ -5567,6 +5556,15 @@ update_profile (Entity_Id gnat_subprog) tree gnu_type = gnat_to_gnu_subprog_type (gnat_subprog, true, Needs_Debug_Info (gnat_subprog), &gnu_param_list); + if (DECL_P (gnu_type)) + { + /* Builtins cannot have their address taken so we can reset them. */ + gcc_assert (DECL_BUILT_IN (gnu_type)); + save_gnu_tree (gnat_subprog, NULL_TREE, false); + save_gnu_tree (gnat_subprog, gnu_type, false); + return; + } + tree gnu_subprog = get_gnu_tree (gnat_subprog); TREE_TYPE (gnu_subprog) = gnu_type; @@ -5575,8 +5573,12 @@ update_profile (Entity_Id gnat_subprog) and needs to be adjusted too. */ if (Ekind (gnat_subprog) != E_Subprogram_Type) { + tree gnu_entity_name = get_entity_name (gnat_subprog); + tree gnu_ext_name + = gnu_ext_name_for_subprog (gnat_subprog, gnu_entity_name); + DECL_ARGUMENTS (gnu_subprog) = gnu_param_list; - finish_subprog_decl (gnu_subprog, gnu_type); + finish_subprog_decl (gnu_subprog, gnu_ext_name, gnu_type); } } @@ -5592,6 +5594,9 @@ update_profiles_with (tree gnu_type) gcc_assert (e); vec *v = e->to; e->to = NULL; + + /* The flag needs to be reset before calling update_profile, in case + associate_subprog_with_dummy_type is again invoked on GNU_TYPE. */ TYPE_DUMMY_IN_PROFILE_P (gnu_type) = 0; unsigned int i; @@ -5678,7 +5683,9 @@ gnat_to_gnu_profile_type (Entity_Id gnat_type) /* Return a GCC tree for a subprogram type corresponding to GNAT_SUBPROG. DEFINITION is true if this is for a subprogram being defined. DEBUG_INFO_P is true if we need to write debug information for other types that we may - create in the process. Also set PARAM_LIST to the list of parameters. */ + create in the process. Also set PARAM_LIST to the list of parameters. + If GNAT_SUBPROG is bound to a GCC builtin, return the DECL for the builtin + directly instead of its type. */ static tree gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, @@ -5687,6 +5694,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, const Entity_Kind kind = Ekind (gnat_subprog); Entity_Id gnat_return_type = Etype (gnat_subprog); Entity_Id gnat_param; + tree gnu_type = present_gnu_tree (gnat_subprog) + ? TREE_TYPE (get_gnu_tree (gnat_subprog)) : NULL_TREE; tree gnu_return_type; tree gnu_param_type_list = NULL_TREE; tree gnu_param_list = NULL_TREE; @@ -5698,6 +5707,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, is the PARM_DECL corresponding to that field. This list will be saved in the TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */ tree gnu_cico_list = NULL_TREE; + tree gnu_cico_return_type = NULL_TREE; /* Fields in return type of procedure with copy-in copy-out parameters. */ tree gnu_field_list = NULL_TREE; /* The semantics of "pure" in Ada essentially matches that of "const" @@ -5715,10 +5725,22 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, bool incomplete_profile_p = false; unsigned int num; - /* Look into the return type and get its associated GCC tree. If it is not - void, compute various flags for the subprogram type. */ + /* Look into the return type and get its associated GCC tree if it is not + void, and then compute various flags for the subprogram type. But make + sure not to do this processing multiple times. */ if (Ekind (gnat_return_type) == E_Void) gnu_return_type = void_type_node; + + else if (gnu_type + && TREE_CODE (gnu_type) == FUNCTION_TYPE + && !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); + } + else { gnu_return_type = gnat_to_gnu_profile_type (gnat_return_type); @@ -5828,7 +5850,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, returns by reference, then the return type is only linked indirectly in the profile, so the profile can be seen as complete since it need not be further modified, only the reference types need be adjusted; - otherwise the profile itself is incomplete and need be adjusted. */ + otherwise the profile is incomplete and need be adjusted too. */ if (TYPE_IS_DUMMY_P (gnu_return_type)) { associate_subprog_with_dummy_type (gnat_subprog, gnu_return_type); @@ -5858,81 +5880,107 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param), num++) { - Entity_Id gnat_param_type = Etype (gnat_param); + const bool mech_is_by_ref + = Mechanism (gnat_param) == By_Reference + && !(num == 0 && Is_Valued_Procedure (gnat_subprog)); tree gnu_param_name = get_entity_name (gnat_param); - tree gnu_param_type = gnat_to_gnu_profile_type (gnat_param_type); - tree gnu_param, gnu_field; + tree gnu_param, gnu_param_type; bool cico = false; - /* If the parameter type is incomplete, there are 2 cases: if it is - passed by reference, then the type is only linked indirectly in - the profile, so the profile can be seen as complete since it need - not be further modified, only the reference types need be adjusted; - otherwise the profile itself is incomplete and need be adjusted. */ - if (TYPE_IS_DUMMY_P (gnu_param_type)) + /* Fetch an existing parameter with complete type and reuse it. But we + didn't save the CICO property so we can only do it for In parameters + or parameters passed by reference. */ + if ((Ekind (gnat_param) == E_In_Parameter || mech_is_by_ref) + && present_gnu_tree (gnat_param) + && (gnu_param = get_gnu_tree (gnat_param)) + && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_param))) { - Node_Id gnat_decl; + DECL_CHAIN (gnu_param) = NULL_TREE; + gnu_param_type = TREE_TYPE (gnu_param); + } - if (Mechanism (gnat_param) == By_Reference - || (TYPE_REFERENCE_TO (gnu_param_type) - && TYPE_IS_FAT_POINTER_P (TYPE_REFERENCE_TO (gnu_param_type))) - || TYPE_IS_BY_REFERENCE_P (gnu_param_type)) + /* Otherwise translate the parameter type and act accordingly. */ + else + { + Entity_Id gnat_param_type = Etype (gnat_param); + gnu_param_type = gnat_to_gnu_profile_type (gnat_param_type); + + /* If the parameter type is incomplete, there are 2 cases: if it is + passed by reference, then the type is only linked indirectly in + the profile, so the profile can be seen as complete since it need + not be further modified, only the reference type need be adjusted; + otherwise the profile is incomplete and need be adjusted too. */ + if (TYPE_IS_DUMMY_P (gnu_param_type)) { - gnu_param_type = build_reference_type (gnu_param_type); - gnu_param = create_param_decl (gnu_param_name, gnu_param_type); - TREE_READONLY (gnu_param) = 1; - DECL_BY_REF_P (gnu_param) = 1; - DECL_POINTS_TO_READONLY_P (gnu_param) - = (Ekind (gnat_param) == E_In_Parameter - && !Address_Taken (gnat_param)); - Set_Mechanism (gnat_param, By_Reference); - Sloc_to_locus (Sloc (gnat_param), - &DECL_SOURCE_LOCATION (gnu_param)); - } + Node_Id gnat_decl; + + if (mech_is_by_ref + || (TYPE_REFERENCE_TO (gnu_param_type) + && TYPE_IS_FAT_POINTER_P + (TYPE_REFERENCE_TO (gnu_param_type))) + || TYPE_IS_BY_REFERENCE_P (gnu_param_type)) + { + gnu_param_type = build_reference_type (gnu_param_type); + gnu_param + = create_param_decl (gnu_param_name, gnu_param_type); + TREE_READONLY (gnu_param) = 1; + DECL_BY_REF_P (gnu_param) = 1; + DECL_POINTS_TO_READONLY_P (gnu_param) + = (Ekind (gnat_param) == E_In_Parameter + && !Address_Taken (gnat_param)); + Set_Mechanism (gnat_param, By_Reference); + Sloc_to_locus (Sloc (gnat_param), + &DECL_SOURCE_LOCATION (gnu_param)); + } - /* ??? This is a kludge to support null procedures in spec taking a - parameter with an untagged incomplete type coming from a limited - context. The front-end creates a body without knowing anything - about the non-limited view, which is illegal Ada and cannot be - reasonably supported. Create a parameter with a fake type. */ - else if (kind == E_Procedure - && (gnat_decl = Parent (gnat_subprog)) - && Nkind (gnat_decl) == N_Procedure_Specification - && Null_Present (gnat_decl) - && IN (Ekind (gnat_param_type), Incomplete_Kind)) - gnu_param = create_param_decl (gnu_param_name, ptr_type_node); + /* ??? This is a kludge to support null procedures in spec taking + a parameter with an untagged incomplete type coming from a + limited context. The front-end creates a body without knowing + anything about the non-limited view, which is illegal Ada and + cannot be supported. Create a parameter with a fake type. */ + else if (kind == E_Procedure + && (gnat_decl = Parent (gnat_subprog)) + && Nkind (gnat_decl) == N_Procedure_Specification + && Null_Present (gnat_decl) + && IN (Ekind (gnat_param_type), Incomplete_Kind)) + gnu_param = create_param_decl (gnu_param_name, ptr_type_node); - else - { - gnu_param = create_param_decl (gnu_param_name, gnu_param_type); - associate_subprog_with_dummy_type (gnat_subprog, gnu_param_type); - incomplete_profile_p = true; + else + { + gnu_param + = create_param_decl (gnu_param_name, gnu_param_type); + associate_subprog_with_dummy_type (gnat_subprog, + gnu_param_type); + incomplete_profile_p = true; + } } - } - - else - { - gnu_param - = gnat_to_gnu_param (gnat_param, num == 0, gnat_subprog, &cico); - /* We are returned either a PARM_DECL or a type if no parameter - needs to be passed; in either case, adjust the type. */ - if (DECL_P (gnu_param)) - gnu_param_type = TREE_TYPE (gnu_param); + /* Otherwise build the parameter declaration normally. */ else { - gnu_param_type = gnu_param; - gnu_param = NULL_TREE; + gnu_param + = gnat_to_gnu_param (gnat_param, num == 0, gnat_subprog, + &cico); + + /* We are returned either a PARM_DECL or a type if no parameter + needs to be passed; in either case, adjust the type. */ + if (DECL_P (gnu_param)) + gnu_param_type = TREE_TYPE (gnu_param); + else + { + gnu_param_type = gnu_param; + gnu_param = NULL_TREE; + } } } - /* If we built a GCC tree for the parameter, register it. */ + /* If we have a GCC tree for the parameter, register it. */ + save_gnu_tree (gnat_param, NULL_TREE, false); if (gnu_param) { gnu_param_type_list = tree_cons (NULL_TREE, gnu_param_type, gnu_param_type_list); gnu_param_list = chainon (gnu_param, gnu_param_list); - save_gnu_tree (gnat_param, NULL_TREE, false); save_gnu_tree (gnat_param, gnu_param, false); /* If a parameter is a pointer, a function may modify memory through @@ -5950,16 +5998,16 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, { if (!gnu_cico_list) { - tree gnu_new_ret_type = make_node (RECORD_TYPE); + gnu_cico_return_type = make_node (RECORD_TYPE); /* If this is a function, we also need a field for the return value to be placed. */ - if (TREE_CODE (gnu_return_type) != VOID_TYPE) + if (!VOID_TYPE_P (gnu_return_type)) { - gnu_field + tree gnu_field = create_field_decl (get_identifier ("RETVAL"), gnu_return_type, - gnu_new_ret_type, NULL_TREE, + gnu_cico_return_type, NULL_TREE, NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_subprog), &DECL_SOURCE_LOCATION (gnu_field)); @@ -5968,17 +6016,18 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, = tree_cons (gnu_field, void_type_node, NULL_TREE); } - gnu_return_type = gnu_new_ret_type; - TYPE_NAME (gnu_return_type) = get_identifier ("RETURN"); + TYPE_NAME (gnu_cico_return_type) = get_identifier ("RETURN"); /* Set a default alignment to speed up accesses. But we should not increase the size of the structure too much, lest it does not fit in return registers anymore. */ - SET_TYPE_ALIGN (gnu_return_type, get_mode_alignment (ptr_mode)); + SET_TYPE_ALIGN (gnu_cico_return_type, + get_mode_alignment (ptr_mode)); } - gnu_field + tree gnu_field = create_field_decl (gnu_param_name, gnu_param_type, - gnu_return_type, NULL_TREE, NULL_TREE, 0, 0); + gnu_cico_return_type, NULL_TREE, NULL_TREE, + 0, 0); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); DECL_CHAIN (gnu_field) = gnu_field_list; @@ -5994,22 +6043,23 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, /* If we have a CICO list but it has only one entry, we convert this function into a function that returns this object. */ if (list_length (gnu_cico_list) == 1) - gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list)); + gnu_cico_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list)); /* Do not finalize the return type if the subprogram is stubbed since structures are incomplete for the back-end. */ else if (Convention (gnat_subprog) != Convention_Stubbed) { - finish_record_type (gnu_return_type, nreverse (gnu_field_list), 0, - false); + finish_record_type (gnu_cico_return_type, nreverse (gnu_field_list), + 0, false); /* Try to promote the mode of the return type if it is passed in registers, again to speed up accesses. */ - if (TYPE_MODE (gnu_return_type) == BLKmode - && !targetm.calls.return_in_memory (gnu_return_type, NULL_TREE)) + if (TYPE_MODE (gnu_cico_return_type) == BLKmode + && !targetm.calls.return_in_memory (gnu_cico_return_type, + NULL_TREE)) { unsigned int size - = TREE_INT_CST_LOW (TYPE_SIZE (gnu_return_type)); + = TREE_INT_CST_LOW (TYPE_SIZE (gnu_cico_return_type)); unsigned int i = BITS_PER_UNIT; machine_mode mode; @@ -6018,18 +6068,21 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, mode = mode_for_size (i, MODE_INT, 0); if (mode != BLKmode) { - SET_TYPE_MODE (gnu_return_type, mode); - SET_TYPE_ALIGN (gnu_return_type, GET_MODE_ALIGNMENT (mode)); - TYPE_SIZE (gnu_return_type) + SET_TYPE_MODE (gnu_cico_return_type, mode); + SET_TYPE_ALIGN (gnu_cico_return_type, + GET_MODE_ALIGNMENT (mode)); + TYPE_SIZE (gnu_cico_return_type) = bitsize_int (GET_MODE_BITSIZE (mode)); - TYPE_SIZE_UNIT (gnu_return_type) + TYPE_SIZE_UNIT (gnu_cico_return_type) = size_int (GET_MODE_SIZE (mode)); } } if (debug_info_p) - rest_of_record_type_compilation (gnu_return_type); + rest_of_record_type_compilation (gnu_cico_return_type); } + + gnu_return_type = gnu_cico_return_type; } /* The lists have been built in reverse. */ @@ -6041,9 +6094,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, /* If the profile is incomplete, we only set the (temporary) return and parameter types; otherwise, we build the full type. In either case, we reuse an already existing GCC tree that we built previously here. */ - tree gnu_type = present_gnu_tree (gnat_subprog) - ? TREE_TYPE (get_gnu_tree (gnat_subprog)) : NULL_TREE; - if (incomplete_profile_p) { if (gnu_type && TREE_CODE (gnu_type) == FUNCTION_TYPE) @@ -6052,6 +6102,9 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, gnu_type = make_node (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; } else { @@ -6091,11 +6144,61 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, if (No_Return (gnat_subprog)) gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); + + /* If this subprogram is expectedly bound to a GCC builtin, fetch the + corresponding DECL node and check the parameter association. */ + if (Convention (gnat_subprog) == Convention_Intrinsic + && Present (Interface_Name (gnat_subprog))) + { + tree gnu_ext_name = create_concat_name (gnat_subprog, NULL); + tree gnu_builtin_decl = builtin_decl_for (gnu_ext_name); + + /* If we have a builtin DECL for that function, use it. Check if + the profiles are compatible and warn if they are not. Note that + the checker is expected to post diagnostics in this case. */ + if (gnu_builtin_decl) + { + intrin_binding_t inb + = { gnat_subprog, gnu_type, TREE_TYPE (gnu_builtin_decl) }; + + if (!intrin_profiles_compatible_p (&inb)) + post_error + ("?profile of& doesn''t match the builtin it binds!", + gnat_subprog); + + return gnu_builtin_decl; + } + + /* Inability to find the builtin DECL most often indicates a genuine + mistake, but imports of unregistered intrinsics are sometimes used + on purpose to allow hooking in alternate bodies; we post a warning + conditioned on Wshadow in this case, to let developers be notified + on demand without risking false positives with common default sets + of options. */ + if (warn_shadow) + post_error ("?gcc intrinsic not found for&!", gnat_subprog); + } } return gnu_type; } +/* Return the external name for GNAT_SUBPROG given its entity name. */ + +static tree +gnu_ext_name_for_subprog (Entity_Id gnat_subprog, tree gnu_entity_name) +{ + tree gnu_ext_name = create_concat_name (gnat_subprog, NULL); + + /* If there was no specified Interface_Name and the external and + internal names of the subprogram are the same, only use the + internal name to allow disambiguation of nested subprograms. */ + if (No (Interface_Name (gnat_subprog)) && gnu_ext_name == gnu_entity_name) + gnu_ext_name = NULL_TREE; + + return gnu_ext_name; +} + /* Like build_qualified_type, but TYPE_QUALS is added to the existing qualifiers on TYPE. */ diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 099923d97fb..fcd866c37cc 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -737,9 +737,9 @@ extern tree create_subprog_decl (tree name, tree asm_name, tree type, bool artificial_p, bool debug_info_p, struct attrib *attr_list, Node_Id gnat_node); -/* Given a subprogram declaration DECL and its TYPE, finish constructing the - subprogram declaration from TYPE. */ -extern void finish_subprog_decl (tree decl, tree type); +/* Given a subprogram declaration DECL, its assembler name and its type, + finish constructing the subprogram declaration from ASM_NAME and TYPE. */ +extern void finish_subprog_decl (tree decl, tree asm_name, tree type); /* Process the attributes in ATTR_LIST for NODE, which is either a DECL or a TYPE. If IN_PLACE is true, the tree pointed to by NODE should not be diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 798048a903d..6a55796a442 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3137,7 +3137,6 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list, { tree subprog_decl = build_decl (input_location, FUNCTION_DECL, name, type); DECL_ARGUMENTS (subprog_decl) = param_decl_list; - finish_subprog_decl (subprog_decl, type); DECL_ARTIFICIAL (subprog_decl) = artificial_p; DECL_EXTERNAL (subprog_decl) = extern_flag; @@ -3175,38 +3174,23 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list, process_attributes (&subprog_decl, &attr_list, true, gnat_node); + /* Once everything is processed, finish the subprogram declaration. */ + finish_subprog_decl (subprog_decl, asm_name, type); + /* Add this decl to the current binding level. */ gnat_pushdecl (subprog_decl, gnat_node); - if (asm_name) - { - /* Let the target mangle the name if this isn't a verbatim asm. */ - if (*IDENTIFIER_POINTER (asm_name) != '*') - asm_name = targetm.mangle_decl_assembler_name (subprog_decl, asm_name); - - SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name); - - /* The expand_main_function circuitry expects "main_identifier_node" to - designate the DECL_NAME of the 'main' entry point, in turn expected - to be declared as the "main" function literally by default. Ada - program entry points are typically declared with a different name - within the binder generated file, exported as 'main' to satisfy the - system expectations. Force main_identifier_node in this case. */ - if (asm_name == main_identifier_node) - DECL_NAME (subprog_decl) = main_identifier_node; - } - /* Output the assembler code and/or RTL for the declaration. */ rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0); return subprog_decl; } -/* Given a subprogram declaration DECL and its TYPE, finish constructing the - subprogram declaration from TYPE. */ +/* Given a subprogram declaration DECL, its assembler name and its type, + finish constructing the subprogram declaration from ASM_NAME and TYPE. */ void -finish_subprog_decl (tree decl, tree type) +finish_subprog_decl (tree decl, tree asm_name, tree type) { tree result_decl = build_decl (DECL_SOURCE_LOCATION (decl), RESULT_DECL, NULL_TREE, @@ -3219,6 +3203,24 @@ finish_subprog_decl (tree decl, tree type) TREE_READONLY (decl) = TYPE_READONLY (type); TREE_SIDE_EFFECTS (decl) = TREE_THIS_VOLATILE (decl) = TYPE_VOLATILE (type); + + if (asm_name) + { + /* Let the target mangle the name if this isn't a verbatim asm. */ + if (*IDENTIFIER_POINTER (asm_name) != '*') + asm_name = targetm.mangle_decl_assembler_name (decl, asm_name); + + SET_DECL_ASSEMBLER_NAME (decl, asm_name); + + /* The expand_main_function circuitry expects "main_identifier_node" to + designate the DECL_NAME of the 'main' entry point, in turn expected + to be declared as the "main" function literally by default. Ada + program entry points are typically declared with a different name + within the binder generated file, exported as 'main' to satisfy the + system expectations. Force main_identifier_node in this case. */ + if (asm_name == main_identifier_node) + DECL_NAME (decl) = main_identifier_node; + } } /* Set up the framework for generating code for SUBPROG_DECL, a subprogram -- 2.30.2