public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-5101] [Ada] Minor cleanup in translation of calls to subprograms
@ 2021-11-10 8:59 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-11-10 8:59 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:f15ad1e3f9488a31abf1c122bd186c1a3d2a5dbc
commit r12-5101-gf15ad1e3f9488a31abf1c122bd186c1a3d2a5dbc
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri Nov 5 12:07:42 2021 +0100
[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.
Diff:
---
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 9fe52cf61d2..0ec81bc541c 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 98b4aaf23a1..449463e799e 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 dc2a03c67a2..a932ca24ce0 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);
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-11-10 8:59 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-10 8:59 [gcc r12-5101] [Ada] Minor cleanup in translation of calls to subprograms Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).