From patchwork Tue Sep 5 09:02:11 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 810016 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461464-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="QFuUa/Q0"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xmghh4Q82z9s72 for ; Tue, 5 Sep 2017 19:02:27 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=mHPGO+Aej9SvtEnW 47OrIYeg9MozuHIVEc5KPWzUki/q2oYWfCNBwg4IWOesBa3n1RTS7YYQ0i8QZps8 4dA5h0YNNOQ9kpbFCPq/Rp1dK4jNqaRLczvLCigHRWq1X/jSMSwXYvfiTfEbWpOf 7q93MlEjI0u87T0XhyKNnRxJd7M= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=F9bRb3ZowhefqYGcNTpiHc Z3n+g=; b=QFuUa/Q0B3FuoEUrQJN2ndPWtiTbY3pB2UEe1tcRSh2/SV139M8Bv7 Hh0z4W525dYEqmLiE139FQDPhse2OAxukEcEOPLW7SFaJAcjZ7xXfgZecWfINNzv M9VTrOuz7o4ropLL2PWr2Zp9OFmTBerIOPTzuZ8wlUjbldnm6oqGk= Received: (qmail 66132 invoked by alias); 5 Sep 2017 09:02:20 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 66123 invoked by uid 89); 5 Sep 2017 09:02:20 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=disturb, IN, padded, (unknown) X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 05 Sep 2017 09:02:14 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 0CFB7822CA for ; Tue, 5 Sep 2017 11:02:12 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id MSKpz122lDdC for ; Tue, 5 Sep 2017 11:02:11 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id BEBDA81F5E for ; Tue, 5 Sep 2017 11:02:11 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Small housekeeping work Date: Tue, 05 Sep 2017 11:02:11 +0200 Message-ID: <2255313.b33igdloK2@polaris> User-Agent: KMail/4.14.10 (Linux/3.16.7-53-desktop; KDE/4.14.9; x86_64; ; ) MIME-Version: 1.0 Tested on x86_64-suse-linux, applied on mainline. 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. 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_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_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;