OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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.
This commit is contained in:
Eric Botcazou 2021-11-05 12:07:42 +01:00 committed by Pierre-Marie de Rodat
parent 0e988162f6
commit f15ad1e3f9
3 changed files with 69 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/gcc-interface/ada-tree.h
View File

@ -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))

21
gcc/ada/gcc-interface/decl.c
View File

@ -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;

118
gcc/ada/gcc-interface/trans.c
View File

@ -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,29 +4483,65 @@ 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))
/* 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 (gnat_name) == N_Explicit_Dereference)
{
tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
gnat_node, N_Raise_Program_Error);
const Entity_Id gnat_prefix_type
= Underlying_Type (Etype (Prefix (gnat_name)));
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);
gnat_actual = Next_Actual (gnat_actual))
add_stmt (gnat_to_gnu (gnat_actual));
gnat_formal = First_Formal_With_Extras (Etype (gnat_name));
variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic);
if (returning_value)
{
*gnu_result_type_p = gnu_result_type;
return build1 (NULL_EXPR, gnu_result_type, call_expr);
}
return call_expr;
/* If the access type doesn't require foreign-compatible representation,
be prepared for descriptors. */
by_descriptor
= targetm.calls.custom_function_descriptors > 0
&& Can_Use_Internal_Rep (gnat_prefix_type);
}
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
{
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. */
@ -4516,39 +4553,6 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
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
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)
{
const Entity_Id gnat_prefix_type
= Underlying_Type (Etype (Prefix (Name (gnat_node))));
gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic);
/* If the access type doesn't require foreign-compatible representation,
be prepared for descriptors. */
by_descriptor
= targetm.calls.custom_function_descriptors > 0
&& Can_Use_Internal_Rep (gnat_prefix_type);
}
else if (Nkind (Name (gnat_node)) == 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);
by_descriptor = false;
}
/* The lifetime of the temporaries created for the call ends right after the
return value is copied, so we can give them the scope of the elaboration
routine at top level. */
@ -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);