* [Ada] Small housekeeping work
@ 2017-09-05 9:02 Eric Botcazou
0 siblings, 0 replies; 2+ messages in thread
From: Eric Botcazou @ 2017-09-05 9:02 UTC (permalink / raw)
To: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 905 bytes --]
Tested on x86_64-suse-linux, applied on mainline.
2017-09-05 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (renaming_from_generic_instantiation_p):Turn to
(renaming_from_instantiation_p): ...this.
* gcc-interface/decl.c (gnat_to_gnu_entity): Use inline predicate
instead of explicit tests on kind of entities. Adjust for renaming.
(gnat_to_gnu_profile_type): Likewise.
(gnat_to_gnu_subprog_type): Likewise.
* gcc-interface/trans.c (Identifier_to_gnu): Likewise.
(Case_Statement_to_gnu): Likewise.
(gnat_to_gnu): Likewise.
(process_freeze_entity): Likewise.
(process_type): Likewise.
(add_stmt_with_node): Adjust for renaming.
* gcc-interface/utils.c (gnat_pushdecl): Adjust for renaming.
(renaming_from_generic_instantiation_p): Rename to...
(renaming_from_instantiation_p): ...this. Use inline predicate.
(pad_type_hasher::keep_cache_entry): Fold.
--
Eric Botcazou
[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 13620 bytes --]
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 251698)
+++ gcc-interface/decl.c (working copy)
@@ -341,14 +341,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
gnat_temp
= Corresponding_Spec (Parent (Declaration_Node (gnat_temp)));
- if (IN (Ekind (gnat_temp), Subprogram_Kind)
+ if (Is_Subprogram (gnat_temp)
&& Present (Protected_Body_Subprogram (gnat_temp)))
gnat_temp = Protected_Body_Subprogram (gnat_temp);
if (Ekind (gnat_temp) == E_Entry
|| Ekind (gnat_temp) == E_Entry_Family
|| Ekind (gnat_temp) == E_Task_Type
- || (IN (Ekind (gnat_temp), Subprogram_Kind)
+ || (Is_Subprogram (gnat_temp)
&& present_gnu_tree (gnat_temp)
&& (current_function_decl
== gnat_to_gnu_entity (gnat_temp, NULL_TREE, false))))
@@ -426,7 +426,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
inherit another source location. */
gnu_entity_name = get_entity_name (gnat_entity);
if (Sloc (gnat_entity) != No_Location
- && !renaming_from_generic_instantiation_p (gnat_entity))
+ && !renaming_from_instantiation_p (gnat_entity))
Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* For cases when we are not defining (i.e., we are referencing from
@@ -2922,7 +2922,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
/* Create the type for a string literal. */
{
Entity_Id gnat_full_type
- = (IN (Ekind (Etype (gnat_entity)), Private_Kind)
+ = (Is_Private_Type (Etype (gnat_entity))
&& Present (Full_View (Etype (gnat_entity)))
? Full_View (Etype (gnat_entity)) : Etype (gnat_entity));
tree gnu_string_type = get_unpadded_type (gnat_full_type);
@@ -3198,7 +3198,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
if (has_discr)
{
/* The actual parent subtype is the full view. */
- if (IN (Ekind (gnat_parent), Private_Kind))
+ if (Is_Private_Type (gnat_parent))
{
if (Present (Full_View (gnat_parent)))
gnat_parent = Full_View (gnat_parent);
@@ -3583,14 +3583,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
Entity_Id gnat_desig_equiv = Gigi_Equivalent_Type (gnat_desig_type);
/* Whether it comes from a limited with. */
const bool is_from_limited_with
- = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
+ = (Is_Incomplete_Type (gnat_desig_equiv)
&& From_Limited_With (gnat_desig_equiv));
/* Whether it is a completed Taft Amendment type. Such a type is to
be treated as coming from a limited with clause if it is not in
the main unit, i.e. we break potential circularities here in case
the body of an external unit is loaded for inter-unit inlining. */
const bool is_completed_taft_type
- = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
+ = (Is_Incomplete_Type (gnat_desig_equiv)
&& Has_Completion_In_Body (gnat_desig_equiv)
&& Present (Full_View (gnat_desig_equiv)));
/* The "full view" of the designated type. If this is an incomplete
@@ -3603,12 +3603,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
Entity_Id gnat_desig_full_direct_first
= (is_from_limited_with
? Non_Limited_View (gnat_desig_equiv)
- : (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind)
+ : (Is_Incomplete_Or_Private_Type (gnat_desig_equiv)
? Full_View (gnat_desig_equiv) : Empty));
Entity_Id gnat_desig_full_direct
= ((is_from_limited_with
&& Present (gnat_desig_full_direct_first)
- && IN (Ekind (gnat_desig_full_direct_first), Private_Kind))
+ && Is_Private_Type (gnat_desig_full_direct_first))
? Full_View (gnat_desig_full_direct_first)
: gnat_desig_full_direct_first);
Entity_Id gnat_desig_full
@@ -3856,9 +3856,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
p->next = defer_incomplete_list;
defer_incomplete_list = p;
}
- else if (!IN (Ekind (Base_Type
- (Directly_Designated_Type (gnat_entity))),
- Incomplete_Or_Private_Kind))
+ else if (!Is_Incomplete_Or_Private_Type
+ (Base_Type (Directly_Designated_Type (gnat_entity))))
gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
NULL_TREE, false);
}
@@ -5484,17 +5483,17 @@ gnat_to_gnu_profile_type (Entity_Id gnat
ought to be merged at some point. */
Entity_Id gnat_equiv = Gigi_Equivalent_Type (gnat_type);
const bool is_from_limited_with
- = (IN (Ekind (gnat_equiv), Incomplete_Kind)
+ = (Is_Incomplete_Type (gnat_equiv)
&& From_Limited_With (gnat_equiv));
Entity_Id gnat_full_direct_first
= (is_from_limited_with
? Non_Limited_View (gnat_equiv)
- : (IN (Ekind (gnat_equiv), Incomplete_Or_Private_Kind)
+ : (Is_Incomplete_Or_Private_Type (gnat_equiv)
? Full_View (gnat_equiv) : Empty));
Entity_Id gnat_full_direct
= ((is_from_limited_with
&& Present (gnat_full_direct_first)
- && IN (Ekind (gnat_full_direct_first), Private_Kind))
+ && Is_Private_Type (gnat_full_direct_first))
? Full_View (gnat_full_direct_first)
: gnat_full_direct_first);
Entity_Id gnat_full = Gigi_Equivalent_Type (gnat_full_direct);
@@ -5818,7 +5817,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat
&& (gnat_decl = Parent (gnat_subprog))
&& Nkind (gnat_decl) == N_Procedure_Specification
&& Null_Present (gnat_decl)
- && IN (Ekind (gnat_param_type), Incomplete_Kind))
+ && Is_Incomplete_Type (gnat_param_type))
gnu_param = create_param_decl (gnu_param_name, ptr_type_node);
else
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 251553)
+++ gcc-interface/gigi.h (working copy)
@@ -998,7 +998,7 @@ extern int fp_size_to_prec (int size);
from the parameter association for the instantiation of a generic. We do
not want to emit source location for them: the code generated for their
initialization is likely to disturb debugging. */
-extern bool renaming_from_generic_instantiation_p (Node_Id gnat_node);
+extern bool renaming_from_instantiation_p (Node_Id gnat_node);
/* Try to process all nodes in the deferred context queue. Keep in the queue
the ones that cannot be processed yet, remove the other ones. If FORCE is
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 251699)
+++ gcc-interface/trans.c (working copy)
@@ -1053,14 +1053,14 @@ Identifier_to_gnu (Node_Id gnat_node, tr
&& (Etype (gnat_node)
== Packed_Array_Impl_Type (gnat_temp_type)))
|| (Is_Class_Wide_Type (Etype (gnat_node)))
- || (IN (Ekind (gnat_temp_type), Incomplete_Or_Private_Kind)
+ || (Is_Incomplete_Or_Private_Type (gnat_temp_type)
&& Present (Full_View (gnat_temp_type))
&& ((Etype (gnat_node) == Full_View (gnat_temp_type))
|| (Is_Packed (Full_View (gnat_temp_type))
&& (Etype (gnat_node)
== Packed_Array_Impl_Type
(Full_View (gnat_temp_type))))))
- || (IN (Ekind (gnat_temp_type), Incomplete_Kind)
+ || (Is_Incomplete_Type (gnat_temp_type)
&& From_Limited_With (gnat_temp_type)
&& Present (Non_Limited_View (gnat_temp_type))
&& Etype (gnat_node) == Non_Limited_View (gnat_temp_type))
@@ -1069,7 +1069,7 @@ Identifier_to_gnu (Node_Id gnat_node, tr
|| Ekind (gnat_temp) == E_Component
|| Ekind (gnat_temp) == E_Constant
|| Ekind (gnat_temp) == E_Loop_Parameter
- || IN (Ekind (gnat_temp), Formal_Kind)));
+ || Is_Formal (gnat_temp)));
/* If this is a reference to a deferred constant whose partial view is an
unconstrained private type, the proper type is on the full view of the
@@ -2558,7 +2558,7 @@ Case_Statement_to_gnu (Node_Id gnat_node
case N_Expanded_Name:
/* This represents either a subtype range or a static value of
some kind; Ekind says which. */
- if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
+ if (Is_Type (Entity (gnat_choice)))
{
tree gnu_type = get_unpadded_type (Entity (gnat_choice));
@@ -6007,7 +6007,7 @@ gnat_to_gnu (Node_Id gnat_node)
/* If this is of a fixed-point type, the value we want is the value of
the corresponding integer. */
- if (IN (Ekind (Underlying_Type (Etype (gnat_node))), Fixed_Point_Kind))
+ if (Is_Fixed_Point_Type (Underlying_Type (Etype (gnat_node))))
{
gnu_result = UI_To_gnu (Corresponding_Integer_Value (gnat_node),
gnu_result_type);
@@ -6599,7 +6599,7 @@ gnat_to_gnu (Node_Id gnat_node)
/* If the result is a pointer type, see if we are improperly
converting to a stricter alignment. */
if (STRICT_ALIGNMENT && POINTER_TYPE_P (gnu_result_type)
- && IN (Ekind (Etype (gnat_node)), Access_Kind))
+ && Is_Access_Type (Etype (gnat_node)))
{
unsigned int align = known_alignment (gnu_expr);
tree gnu_obj_type = TREE_TYPE (gnu_result_type);
@@ -8110,8 +8110,7 @@ add_stmt_with_node (tree gnu_stmt, Node_
{
/* Do not emit a location for renamings that come from generic instantiation,
they are likely to disturb debugging. */
- if (Present (gnat_node)
- && !renaming_from_generic_instantiation_p (gnat_node))
+ if (Present (gnat_node) && !renaming_from_instantiation_p (gnat_node))
set_expr_location_from_node (gnu_stmt, gnat_node);
add_stmt (gnu_stmt);
}
@@ -8748,14 +8747,14 @@ process_freeze_entity (Node_Id gnat_node
{
save_gnu_tree (gnat_entity, NULL_TREE, false);
- if (IN (kind, Incomplete_Or_Private_Kind)
+ if (Is_Incomplete_Or_Private_Type (gnat_entity)
&& Present (Full_View (gnat_entity)))
{
Entity_Id full_view = Full_View (gnat_entity);
save_gnu_tree (full_view, NULL_TREE, false);
- if (IN (Ekind (full_view), Private_Kind)
+ if (Is_Private_Type (full_view)
&& Present (Underlying_Full_View (full_view)))
{
full_view = Underlying_Full_View (full_view);
@@ -8763,18 +8762,18 @@ process_freeze_entity (Node_Id gnat_node
}
}
- if (IN (kind, Type_Kind)
+ if (Is_Type (gnat_entity)
&& Present (Class_Wide_Type (gnat_entity))
&& Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
save_gnu_tree (Class_Wide_Type (gnat_entity), NULL_TREE, false);
}
- if (IN (kind, Incomplete_Or_Private_Kind)
+ if (Is_Incomplete_Or_Private_Type (gnat_entity)
&& Present (Full_View (gnat_entity)))
{
Entity_Id full_view = Full_View (gnat_entity);
- if (IN (Ekind (full_view), Private_Kind)
+ if (Is_Private_Type (full_view)
&& Present (Underlying_Full_View (full_view)))
full_view = Underlying_Full_View (full_view);
@@ -8806,7 +8805,7 @@ process_freeze_entity (Node_Id gnat_node
gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, true);
}
- if (IN (kind, Type_Kind)
+ if (Is_Type (gnat_entity)
&& Present (Class_Wide_Type (gnat_entity))
&& Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
save_gnu_tree (Class_Wide_Type (gnat_entity), gnu_new, false);
@@ -9626,7 +9625,7 @@ process_type (Entity_Id gnat_entity)
{
tree gnu_decl = TYPE_STUB_DECL (make_dummy_type (gnat_entity));
save_gnu_tree (gnat_entity, gnu_decl, false);
- if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
+ if (Is_Incomplete_Or_Private_Type (gnat_entity)
&& Present (Full_View (gnat_entity)))
{
if (Has_Completion_In_Body (gnat_entity))
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 251553)
+++ gcc-interface/utils.c (working copy)
@@ -231,11 +231,15 @@ struct pad_type_hasher : ggc_cache_ptr_h
{
static inline hashval_t hash (pad_type_hash *t) { return t->hash; }
static bool equal (pad_type_hash *a, pad_type_hash *b);
- static int keep_cache_entry (pad_type_hash *&);
+
+ static int
+ keep_cache_entry (pad_type_hash *&t)
+ {
+ return ggc_marked_p (t->type);
+ }
};
-static GTY ((cache))
- hash_table<pad_type_hasher> *pad_type_hash_table;
+static GTY ((cache)) hash_table<pad_type_hasher> *pad_type_hash_table;
static tree merge_sizes (tree, tree, tree, bool, bool);
static tree fold_bit_position (const_tree);
@@ -750,7 +754,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_n
TREE_NO_WARNING (decl) = (No (gnat_node) || Warnings_Off (gnat_node));
/* Set the location of DECL and emit a declaration for it. */
- if (Present (gnat_node) && !renaming_from_generic_instantiation_p (gnat_node))
+ if (Present (gnat_node) && !renaming_from_instantiation_p (gnat_node))
Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
add_decl_expr (decl, gnat_node);
@@ -1192,14 +1196,6 @@ make_type_from_size (tree type, tree siz
return type;
}
-/* See if the data pointed to by the hash table slot is marked. */
-
-int
-pad_type_hasher::keep_cache_entry (pad_type_hash *&t)
-{
- return ggc_marked_p (t->type);
-}
-
/* Return true iff the padded types are equivalent. */
bool
@@ -2899,10 +2895,10 @@ value_factor_p (tree value, HOST_WIDE_IN
initialization is likely to disturb debugging. */
bool
-renaming_from_generic_instantiation_p (Node_Id gnat_node)
+renaming_from_instantiation_p (Node_Id gnat_node)
{
if (Nkind (gnat_node) != N_Defining_Identifier
- || !IN (Ekind (gnat_node), Object_Kind)
+ || !Is_Object (gnat_node)
|| Comes_From_Source (gnat_node)
|| !Present (Renamed_Object (gnat_node)))
return false;
^ permalink raw reply [flat|nested] 2+ messages in thread
* [Ada] Small housekeeping work
@ 2022-05-19 14:15 Pierre-Marie de Rodat
0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2022-05-19 14:15 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 241 bytes --]
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* gcc-interface/trans.cc (Subprogram_Body_to_gnu): Rename a couple
of local variables and use Is_Generic_Subprogram predicate.
(process_decls): Likewise.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 9223 bytes --]
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -3848,11 +3848,11 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
specification has appeared before for this body, then the identifier
occurring in that specification will also be a defining identifier and all
the calls to this subprogram will point to that specification. */
- Entity_Id gnat_subprog_id
+ Entity_Id gnat_subprog
= (Present (Corresponding_Spec (gnat_node))
? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node));
/* The FUNCTION_DECL node corresponding to the subprogram spec. */
- tree gnu_subprog_decl;
+ tree gnu_subprog;
/* Its RESULT_DECL node. */
tree gnu_result_decl;
/* Its FUNCTION_TYPE node. */
@@ -3866,11 +3866,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
struct language_function *gnu_subprog_language;
vec<parm_attr, va_gc> *cache;
- /* If this is a generic object or if it has been eliminated,
- ignore it. */
- if (Ekind (gnat_subprog_id) == E_Generic_Procedure
- || Ekind (gnat_subprog_id) == E_Generic_Function
- || Is_Eliminated (gnat_subprog_id))
+ /* If this is a generic subprogram or it has been eliminated, ignore it. */
+ if (Is_Generic_Subprogram (gnat_subprog) || Is_Eliminated (gnat_subprog))
return;
/* If this subprogram acts as its own spec, define it. Otherwise, just get
@@ -3879,13 +3876,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
treat it as not being defined in that case. Such a subprogram cannot
have an address clause or a freeze node, so this test is safe, though it
does disable some otherwise-useful error checking. */
- gnu_subprog_decl
- = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
+ gnu_subprog
+ = gnat_to_gnu_entity (gnat_subprog, NULL_TREE,
Acts_As_Spec (gnat_node)
- && !present_gnu_tree (gnat_subprog_id));
- DECL_FUNCTION_IS_DEF (gnu_subprog_decl) = true;
- gnu_result_decl = DECL_RESULT (gnu_subprog_decl);
- gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
+ && !present_gnu_tree (gnat_subprog));
+ DECL_FUNCTION_IS_DEF (gnu_subprog) = true;
+ gnu_result_decl = DECL_RESULT (gnu_subprog);
+ gnu_subprog_type = TREE_TYPE (gnu_subprog);
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
if (gnu_cico_list && TREE_VALUE (gnu_cico_list) == void_type_node)
gnu_return_var_elmt = gnu_cico_list;
@@ -3900,25 +3897,25 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
}
/* Set the line number in the decl to correspond to that of the body. */
- if (DECL_IGNORED_P (gnu_subprog_decl))
+ if (DECL_IGNORED_P (gnu_subprog))
locus = UNKNOWN_LOCATION;
- else if (!Sloc_to_locus (Sloc (gnat_node), &locus, false, gnu_subprog_decl))
+ else if (!Sloc_to_locus (Sloc (gnat_node), &locus, false, gnu_subprog))
locus = input_location;
- DECL_SOURCE_LOCATION (gnu_subprog_decl) = locus;
+ DECL_SOURCE_LOCATION (gnu_subprog) = locus;
/* Try to create a bona-fide thunk and hand it over to the middle-end. */
- if (Is_Thunk (gnat_subprog_id)
- && maybe_make_gnu_thunk (gnat_subprog_id, gnu_subprog_decl))
+ if (Is_Thunk (gnat_subprog)
+ && maybe_make_gnu_thunk (gnat_subprog, gnu_subprog))
return;
/* Initialize the information structure for the function. */
- allocate_struct_function (gnu_subprog_decl, false);
+ allocate_struct_function (gnu_subprog, false);
gnu_subprog_language = ggc_cleared_alloc<language_function> ();
- DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language = gnu_subprog_language;
- DECL_STRUCT_FUNCTION (gnu_subprog_decl)->function_start_locus = locus;
+ DECL_STRUCT_FUNCTION (gnu_subprog)->language = gnu_subprog_language;
+ DECL_STRUCT_FUNCTION (gnu_subprog)->function_start_locus = locus;
set_cfun (NULL);
- begin_subprog_body (gnu_subprog_decl);
+ begin_subprog_body (gnu_subprog);
/* If there are copy-in/copy-out parameters, we need to ensure that they are
properly copied out by the return statement. We do this by making a new
@@ -3946,7 +3943,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
= create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
gnu_return_type, NULL_TREE,
false, false, false, false, false,
- true, false, NULL, gnat_subprog_id);
+ true, false, NULL, gnat_subprog);
TREE_VALUE (gnu_return_var_elmt) = gnu_return_var;
}
@@ -3957,7 +3954,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
put it into TYPE_CI_CO_LIST, which must contain an empty entry too.
We can match up the entries because TYPE_CI_CO_LIST is in the order
of the parameters. */
- for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
+ for (gnat_param = First_Formal_With_Extras (gnat_subprog);
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param))
if (!present_gnu_tree (gnat_param))
@@ -3999,7 +3996,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
/* Attempt setting the end_locus of our GCC body tree, typically a BIND_EXPR,
then the end_locus of our GCC subprogram declaration tree. */
set_end_locus_from_node (gnu_result, gnat_node);
- set_end_locus_from_node (gnu_subprog_decl, gnat_node);
+ set_end_locus_from_node (gnu_subprog, gnat_node);
/* If we populated the parameter attributes cache, we need to make sure that
the cached expressions are evaluated on all the possible paths leading to
@@ -4097,7 +4094,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
/* On SEH targets, install an exception handler around the main entry
point to catch unhandled exceptions. */
- if (DECL_NAME (gnu_subprog_decl) == main_identifier_node
+ if (DECL_NAME (gnu_subprog) == main_identifier_node
&& targetm_common.except_unwind_info (&global_options) == UI_SEH)
{
tree t;
@@ -4119,7 +4116,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
/* Finally annotate the parameters and disconnect the trees for parameters
that we have turned into variables since they are now unusable. */
- for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
+ for (gnat_param = First_Formal_With_Extras (gnat_subprog);
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param))
{
@@ -4141,7 +4138,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
a Named Return Value, finalize the optimization. */
if (optimize && !optimize_debug && gnu_subprog_language->named_ret_val)
{
- finalize_nrv (gnu_subprog_decl,
+ finalize_nrv (gnu_subprog,
gnu_subprog_language->named_ret_val,
gnu_subprog_language->other_ret_val,
gnu_subprog_language->gnat_ret);
@@ -4151,10 +4148,10 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
/* If this is an inlined external function that has been marked uninlinable,
drop the body and stop there. Otherwise compile the body. */
- if (DECL_EXTERNAL (gnu_subprog_decl) && DECL_UNINLINABLE (gnu_subprog_decl))
- DECL_SAVED_TREE (gnu_subprog_decl) = NULL_TREE;
+ if (DECL_EXTERNAL (gnu_subprog) && DECL_UNINLINABLE (gnu_subprog))
+ DECL_SAVED_TREE (gnu_subprog) = NULL_TREE;
else
- rest_of_subprog_body_compilation (gnu_subprog_decl);
+ rest_of_subprog_body_compilation (gnu_subprog);
}
/* The type of an atomic access. */
@@ -9224,31 +9221,29 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2,
record_code_position
(Proper_Body (Unit (Library_Unit (gnat_decl))));
- /* We defer most subprogram bodies to the second pass. */
+ /* We defer most subprogram bodies to the second pass. For bodies
+ that act as their own specs and stubs, the entity itself must be
+ elaborated in the first pass, because it may be used in other
+ declarations. */
else if (Nkind (gnat_decl) == N_Subprogram_Body)
{
if (Acts_As_Spec (gnat_decl))
{
- Node_Id gnat_subprog_id = Defining_Entity (gnat_decl);
+ Entity_Id gnat_subprog = Defining_Entity (gnat_decl);
- if (Ekind (gnat_subprog_id) != E_Generic_Procedure
- && Ekind (gnat_subprog_id) != E_Generic_Function)
- gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true);
+ if (!Is_Generic_Subprogram (gnat_subprog))
+ gnat_to_gnu_entity (gnat_subprog, NULL_TREE, true);
}
}
- /* For bodies and stubs that act as their own specs, the entity
- itself must be elaborated in the first pass, because it may
- be used in other declarations. */
else if (Nkind (gnat_decl) == N_Subprogram_Body_Stub)
{
- Node_Id gnat_subprog_id
+ Entity_Id gnat_subprog
= Defining_Entity (Specification (gnat_decl));
- if (Ekind (gnat_subprog_id) != E_Subprogram_Body
- && Ekind (gnat_subprog_id) != E_Generic_Procedure
- && Ekind (gnat_subprog_id) != E_Generic_Function)
- gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true);
+ if (!Is_Generic_Subprogram (gnat_subprog)
+ && Ekind (gnat_subprog) != E_Subprogram_Body)
+ gnat_to_gnu_entity (gnat_subprog, NULL_TREE, true);
}
/* Concurrent stubs stand for the corresponding subprogram bodies,
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2022-05-19 14:15 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-05 9:02 [Ada] Small housekeeping work Eric Botcazou
2022-05-19 14:15 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).