Tested on x86_64-suse-linux, applied on mainline.
2017-09-05 Eric Botcazou <ebotca...@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
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;