From f15ad1e3f9488a31abf1c122bd186c1a3d2a5dbc Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 5 Nov 2021 12:07:42 +0100 Subject: [PATCH] [Ada] Minor cleanup in translation of calls to subprograms gcc/ada/ * gcc-interface/ada-tree.h (DECL_STUBBED_P): Delete. * gcc-interface/decl.c (gnat_to_gnu_entity): Do not set it. * gcc-interface/trans.c (Call_to_gnu): Use GNAT_NAME local variable and adjust accordingly. Replace test on DECL_STUBBED_P with direct test on Convention and move it down in the processing. --- gcc/ada/gcc-interface/ada-tree.h | 4 -- gcc/ada/gcc-interface/decl.c | 21 +++---- gcc/ada/gcc-interface/trans.c | 100 ++++++++++++++++--------------- 3 files changed, 60 insertions(+), 65 deletions(-) diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 9fe52cf61d26..0ec81bc541c2 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -410,10 +410,6 @@ do { \ /* Flags added to decl nodes. */ -/* Nonzero in a FUNCTION_DECL that represents a stubbed function - discriminant. */ -#define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE)) - /* Nonzero in a VAR_DECL if it is guaranteed to be constant after having been elaborated and TREE_READONLY is not set on it. */ #define DECL_READONLY_ONCE_ELAB(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE)) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 98b4aaf23a1b..449463e799ec 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4095,19 +4095,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) else if (extern_flag && gnu_ext_name == DECL_NAME (realloc_decl)) gnu_decl = realloc_decl; else - { - gnu_decl - = create_subprog_decl (gnu_entity_name, gnu_ext_name, - gnu_type, gnu_param_list, - inline_status, public_flag, - extern_flag, artificial_p, - debug_info_p, - definition && imported_p, attr_list, - gnat_entity); - - DECL_STUBBED_P (gnu_decl) - = (Convention (gnat_entity) == Convention_Stubbed); - } + gnu_decl + = create_subprog_decl (gnu_entity_name, gnu_ext_name, + gnu_type, gnu_param_list, + inline_status, public_flag, + extern_flag, artificial_p, + debug_info_p, + definition && imported_p, attr_list, + gnat_entity); } } break; diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index dc2a03c67a21..a932ca24ce04 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4453,13 +4453,14 @@ static tree Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, atomic_acces_t atomic_access, bool atomic_sync) { + const Node_Id gnat_name = Name (gnat_node); const bool function_call = (Nkind (gnat_node) == N_Function_Call); const bool returning_value = (function_call && !gnu_target); /* The GCC node corresponding to the GNAT subprogram name. This can either be a FUNCTION_DECL node if we are dealing with a standard subprogram call, or an indirect reference expression (an INDIRECT_REF node) pointing to a subprogram. */ - tree gnu_subprog = gnat_to_gnu (Name (gnat_node)); + tree gnu_subprog = gnat_to_gnu (gnat_name); /* The FUNCTION_TYPE node giving the GCC type of the subprogram. */ tree gnu_subprog_type = TREE_TYPE (gnu_subprog); /* The return type of the FUNCTION_TYPE. */ @@ -4482,50 +4483,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, atomic_acces_t aa_type; bool aa_sync; - gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type)); - - /* If we are calling a stubbed function, raise Program_Error, but Elaborate - all our args first. */ - if (TREE_CODE (gnu_subprog) == FUNCTION_DECL && DECL_STUBBED_P (gnu_subprog)) - { - tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called, - gnat_node, N_Raise_Program_Error); - - for (gnat_actual = First_Actual (gnat_node); - Present (gnat_actual); - gnat_actual = Next_Actual (gnat_actual)) - add_stmt (gnat_to_gnu (gnat_actual)); - - if (returning_value) - { - *gnu_result_type_p = gnu_result_type; - return build1 (NULL_EXPR, gnu_result_type, call_expr); - } - - return call_expr; - } - - if (TREE_CODE (gnu_subprog) == FUNCTION_DECL) - { - /* For a call to a nested function, check the inlining status. */ - if (decl_function_context (gnu_subprog)) - check_inlining_for_nested_subprog (gnu_subprog); - - /* For a recursive call, avoid explosion due to recursive inlining. */ - if (gnu_subprog == current_function_decl) - DECL_DISREGARD_INLINE_LIMITS (gnu_subprog) = 0; - } - - /* The only way we can be making a call via an access type is if Name is an + /* The only way we can make a call via an access type is if GNAT_NAME is an explicit dereference. In that case, get the list of formal args from the type the access type is pointing to. Otherwise, get the formals from the entity being called. */ - if (Nkind (Name (gnat_node)) == N_Explicit_Dereference) + if (Nkind (gnat_name) == N_Explicit_Dereference) { const Entity_Id gnat_prefix_type - = Underlying_Type (Etype (Prefix (Name (gnat_node)))); + = Underlying_Type (Etype (Prefix (gnat_name))); - gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node))); + gnat_formal = First_Formal_With_Extras (Etype (gnat_name)); variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic); /* If the access type doesn't require foreign-compatible representation, @@ -4534,19 +4501,56 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = targetm.calls.custom_function_descriptors > 0 && Can_Use_Internal_Rep (gnat_prefix_type); } - else if (Nkind (Name (gnat_node)) == N_Attribute_Reference) + + else if (Nkind (gnat_name) == N_Attribute_Reference) { /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */ gnat_formal = Empty; variadic = false; by_descriptor = false; } + else { - gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node))); - variadic - = IN (Convention (Entity (Name (gnat_node))), Convention_C_Variadic); + gcc_checking_assert (Is_Entity_Name (gnat_name)); + + gnat_formal = First_Formal_With_Extras (Entity (gnat_name)); + variadic = IN (Convention (Entity (gnat_name)), Convention_C_Variadic); by_descriptor = false; + + /* If we are calling a stubbed function, then raise Program_Error, but + elaborate all our args first. */ + if (Convention (Entity (gnat_name)) == Convention_Stubbed) + { + tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called, + gnat_node, N_Raise_Program_Error); + + for (gnat_actual = First_Actual (gnat_node); + Present (gnat_actual); + gnat_actual = Next_Actual (gnat_actual)) + add_stmt (gnat_to_gnu (gnat_actual)); + + if (returning_value) + { + *gnu_result_type_p = gnu_result_type; + return build1 (NULL_EXPR, gnu_result_type, call_expr); + } + + return call_expr; + } + } + + gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type)); + + if (TREE_CODE (gnu_subprog) == FUNCTION_DECL) + { + /* For a call to a nested function, check the inlining status. */ + if (decl_function_context (gnu_subprog)) + check_inlining_for_nested_subprog (gnu_subprog); + + /* For a recursive call, avoid explosion due to recursive inlining. */ + if (gnu_subprog == current_function_decl) + DECL_DISREGARD_INLINE_LIMITS (gnu_subprog) = 0; } /* The lifetime of the temporaries created for the call ends right after the @@ -4765,8 +4769,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* Do not initialize it for the _Init parameter of an initialization procedure since no data is meant to be passed in. */ if (Ekind (gnat_formal) == E_Out_Parameter - && Is_Entity_Name (Name (gnat_node)) - && Is_Init_Proc (Entity (Name (gnat_node)))) + && Is_Entity_Name (gnat_name) + && Is_Init_Proc (Entity (gnat_name))) gnu_name = gnu_temp = create_temporary ("A", TREE_TYPE (gnu_name)); /* Initialize it on the fly like for an implicit temporary in the @@ -5097,10 +5101,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, if (function_call) gnu_cico_list = TREE_CHAIN (gnu_cico_list); - if (Nkind (Name (gnat_node)) == N_Explicit_Dereference) - gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node))); + if (Nkind (gnat_name) == N_Explicit_Dereference) + gnat_formal = First_Formal_With_Extras (Etype (gnat_name)); else - gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node))); + gnat_formal = First_Formal_With_Extras (Entity (gnat_name)); for (gnat_actual = First_Actual (gnat_node); Present (gnat_actual); -- 2.39.3