From 7ed9919dff52443091071203bf93685cf78002a3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 5 Sep 2017 09:02:07 +0000 Subject: [PATCH] gigi.h (renaming_from_generic_instantiation_p): Turn to * 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. From-SVN: r251700 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/gcc-interface/decl.c | 31 +++++++++++++++---------------- gcc/ada/gcc-interface/gigi.h | 2 +- gcc/ada/gcc-interface/trans.c | 29 ++++++++++++++--------------- gcc/ada/gcc-interface/utils.c | 24 ++++++++++-------------- 5 files changed, 59 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 61cd24bf370..a263b95e08b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2017-09-05 Eric Botcazou + + * 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. + 2017-09-05 Eric Botcazou * gcc-interface/trans.c (adjust_for_implicit_deref): New function. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0a1796a6614..569fe859d4e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -341,14 +341,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) 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_entity, tree gnu_expr, bool definition) 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_entity, tree gnu_expr, bool definition) /* 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_entity, tree gnu_expr, bool definition) 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_entity, tree gnu_expr, bool definition) 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_entity, tree gnu_expr, bool definition) 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_entity, tree gnu_expr, bool definition) 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_type) 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_subprog, bool definition, && (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 diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 0e25b6129a3..a5084c68415 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 78d918fcd89..270bf7a49dc 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1053,14 +1053,14 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) && (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, tree *gnu_result_type_p) || 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_Id gnat_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)) diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 951089865e5..b0f6d2dba1e 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -231,11 +231,15 @@ struct pad_type_hasher : ggc_cache_ptr_hash { 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_hash_table; +static GTY ((cache)) hash_table *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_node) 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 size_tree, bool for_biased) 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_INT factor) 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; -- 2.30.2