From patchwork Mon May 15 08:14:34 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 762294 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 3wRCzz6Kvsz9s7k for ; Mon, 15 May 2017 18:14:53 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="L6sjzscf"; dkim-atps=neutral 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=cntUnWnSvAt9jCL8 6LxmQ6tFkfi12xAXXg/dNJvClPd7M/CHh+nOc/IK0IwOdn2KBh+WhIEHOcJpxbfu DgvAwSDIpUHsrnUd984OSs9976U3W6VNRNVg2fYiIXT+PGC5Bc1PELmZ/jNGwaXV Man0yMrZ/v00IifFt+p/Zrm4Mzs= 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=bd0EZBIhlH22VgYmxjzcZZ RTTEY=; b=L6sjzscffibnEyq9LvmDjAD0Qb5w2Jgx20vbPqCtyffJfErE4CopwG mmJpcQRFfMtal/OvsRuiBZYtfCp3wHHfiCOKbjuzwTdVLcfytl9s9BnhCWIRRdYo W/OzycPAbxz4LNvO412YwXdFlYKUlL89xc1tGbXnuVDEyjEkylH54= Received: (qmail 88602 invoked by alias); 15 May 2017 08:14:37 -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 87941 invoked by uid 89); 15 May 2017 08:14:36 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-14.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=rescue, FORCE, associations, 30007 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; Mon, 15 May 2017 08:14:34 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id D876081333 for ; Mon, 15 May 2017 10:14:34 +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 A4WV573OS76T for ; Mon, 15 May 2017 10:14:34 +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 A273B81330 for ; Mon, 15 May 2017 10:14:34 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] A bit of housekeeping work in gigi Date: Mon, 15 May 2017 10:14:34 +0200 Message-ID: <5035297.Y4cn0NsbEU@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 the mainline. 2017-05-15 Eric Botcazou * gcc-interface/trans.c (gnat_to_gnu) : Fix formatting. : Use properly typed constants. (extract_values): Move around. (pos_to_constructor): Minor tweaks. (Sloc_to_locus): Fix formatting. * gcc-interface/utils.c (process_deferred_decl_context): Minor tweaks. * gcc-interface/gigi.h (MARK_VISITED): Remove blank line. (Gigi_Equivalent_Type): Adjust head comment. * gcc-interface/decl.c (Gigi_Equivalent_Type): Likewise. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 248049) +++ gcc-interface/decl.c (working copy) @@ -3270,12 +3270,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit } /* If we have a derived untagged type that renames discriminants in - the root type, the (stored) discriminants are just a copy of the - discriminants of the root type. This means that any constraints - added by the renaming in the derivation are disregarded as far - as the layout of the derived type is concerned. To rescue them, - we change the type of the (stored) discriminants to a subtype - with the bounds of the type of the visible discriminants. */ + the parent type, the (stored) discriminants are just a copy of the + discriminants of the parent type. This means that any constraints + added by the renaming in the derivation are disregarded as far as + the layout of the derived type is concerned. To rescue them, we + change the type of the (stored) discriminants to a subtype with + the bounds of the type of the visible discriminants. */ if (has_discr && !is_extension && Stored_Constraint (gnat_entity) != No_Elist) @@ -4967,12 +4967,10 @@ finalize_from_limited_with (void) } } -/* Return the equivalent type to be used for GNAT_ENTITY, if it's a - kind of type (such E_Task_Type) that has a different type which Gigi - uses for its representation. If the type does not have a special type - for its representation, return GNAT_ENTITY. If a type is supposed to - exist, but does not, abort unless annotating types, in which case - return Empty. If GNAT_ENTITY is Empty, return Empty. */ +/* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind + of type (such E_Task_Type) that has a different type which Gigi uses + for its representation. If the type does not have a special type for + its representation, return GNAT_ENTITY. */ Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity) Index: gcc-interface/gigi.h =================================================================== --- gcc-interface/gigi.h (revision 247951) +++ gcc-interface/gigi.h (working copy) @@ -88,7 +88,6 @@ extern void mark_visited (tree t); /* This macro calls the above function but short-circuits the common case of a constant to save time and also checks for NULL. */ - #define MARK_VISITED(EXP) \ do { \ if((EXP) && !CONSTANT_CLASS_P (EXP)) \ @@ -98,12 +97,10 @@ do { \ /* Finalize the processing of From_Limited_With incomplete types. */ extern void finalize_from_limited_with (void); -/* Return the equivalent type to be used for GNAT_ENTITY, if it's a - kind of type (such E_Task_Type) that has a different type which Gigi - uses for its representation. If the type does not have a special type - for its representation, return GNAT_ENTITY. If a type is supposed to - exist, but does not, abort unless annotating types, in which case - return Empty. If GNAT_ENTITY is Empty, return Empty. */ +/* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind + of type (such E_Task_Type) that has a different type which Gigi uses + for its representation. If the type does not have a special type for + its representation, return GNAT_ENTITY. */ extern Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity); /* Given GNAT_ENTITY, elaborate all expressions that are required to Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 247951) +++ gcc-interface/trans.c (working copy) @@ -237,7 +237,6 @@ static tree build_binary_op_trapv (enum static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id); static bool addressable_p (tree, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree); -static tree extract_values (tree, tree); static tree pos_to_constructor (Node_Id, tree, Entity_Id); static void validate_unchecked_conversion (Node_Id); static tree maybe_implicit_deref (tree); @@ -6497,8 +6496,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type); if (Null_Record_Present (gnat_node)) - gnu_result = gnat_build_constructor (gnu_aggr_type, - NULL); + gnu_result = gnat_build_constructor (gnu_aggr_type, NULL); else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE || TREE_CODE (gnu_aggr_type) == UNION_TYPE) @@ -6858,7 +6856,7 @@ gnat_to_gnu (Node_Id gnat_node) case N_Allocator: { - tree gnu_init = 0; + tree gnu_init = NULL_TREE; tree gnu_type; bool ignore_init_type = false; @@ -9658,6 +9656,55 @@ process_type (Entity_Id gnat_entity) } } +/* Subroutine of assoc_to_constructor: VALUES is a list of field associations, + some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the + associations that are from RECORD_TYPE. If we see an internal record, make + a recursive call to fill it in as well. */ + +static tree +extract_values (tree values, tree record_type) +{ + vec *v = NULL; + tree field; + + for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) + { + tree tem, value = NULL_TREE; + + /* _Parent is an internal field, but may have values in the aggregate, + so check for values first. */ + if ((tem = purpose_member (field, values))) + { + value = TREE_VALUE (tem); + TREE_ADDRESSABLE (tem) = 1; + } + + else if (DECL_INTERNAL_P (field)) + { + value = extract_values (values, TREE_TYPE (field)); + if (TREE_CODE (value) == CONSTRUCTOR + && vec_safe_is_empty (CONSTRUCTOR_ELTS (value))) + value = NULL_TREE; + } + else + /* If we have a record subtype, the names will match, but not the + actual FIELD_DECLs. */ + for (tem = values; tem; tem = TREE_CHAIN (tem)) + if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field)) + { + value = convert (TREE_TYPE (field), TREE_VALUE (tem)); + TREE_ADDRESSABLE (tem) = 1; + } + + if (!value) + continue; + + CONSTRUCTOR_APPEND_ELT (v, field, value); + } + + return gnat_build_constructor (record_type, v); +} + /* GNAT_ENTITY is the type of the resulting constructor, GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate and GNU_TYPE is the GCC type of the corresponding record type. Return the CONSTRUCTOR. */ @@ -9728,11 +9775,12 @@ pos_to_constructor (Node_Id gnat_expr, t Entity_Id gnat_component_type) { tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type)); - tree gnu_expr; vec *gnu_expr_vec = NULL; - for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr)) + for (; Present (gnat_expr); gnat_expr = Next (gnat_expr)) { + tree gnu_expr; + /* If the expression is itself an array aggregate then first build the innermost constructor if it is part of our array (multi-dimensional case). */ @@ -9763,55 +9811,6 @@ pos_to_constructor (Node_Id gnat_expr, t return gnat_build_constructor (gnu_array_type, gnu_expr_vec); } -/* Subroutine of assoc_to_constructor: VALUES is a list of field associations, - some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the - associations that are from RECORD_TYPE. If we see an internal record, make - a recursive call to fill it in as well. */ - -static tree -extract_values (tree values, tree record_type) -{ - tree field, tem; - vec *v = NULL; - - for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) - { - tree value = 0; - - /* _Parent is an internal field, but may have values in the aggregate, - so check for values first. */ - if ((tem = purpose_member (field, values))) - { - value = TREE_VALUE (tem); - TREE_ADDRESSABLE (tem) = 1; - } - - else if (DECL_INTERNAL_P (field)) - { - value = extract_values (values, TREE_TYPE (field)); - if (TREE_CODE (value) == CONSTRUCTOR - && vec_safe_is_empty (CONSTRUCTOR_ELTS (value))) - value = 0; - } - else - /* If we have a record subtype, the names will match, but not the - actual FIELD_DECLs. */ - for (tem = values; tem; tem = TREE_CHAIN (tem)) - if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field)) - { - value = convert (TREE_TYPE (field), TREE_VALUE (tem)); - TREE_ADDRESSABLE (tem) = 1; - } - - if (!value) - continue; - - CONSTRUCTOR_APPEND_ELT (v, field, value); - } - - return gnat_build_constructor (record_type, v); -} - /* Process a N_Validate_Unchecked_Conversion node. */ static void @@ -9915,8 +9914,8 @@ Sloc_to_locus (Source_Ptr Sloc, location line = 1; /* Translate the location. */ - *locus = linemap_position_for_line_and_column (line_table, map, - line, column); + *locus + = linemap_position_for_line_and_column (line_table, map, line, column); return true; } Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 247951) +++ gcc-interface/utils.c (working copy) @@ -2992,7 +2992,7 @@ process_deferred_decl_context (bool forc struct deferred_decl_context_node **it = &deferred_decl_context_queue; struct deferred_decl_context_node *node; - while (*it != NULL) + while (*it) { bool processed = false; tree context = NULL_TREE; @@ -3000,7 +3000,7 @@ process_deferred_decl_context (bool forc node = *it; - /* If FORCE, get the innermost elaborated scope. Otherwise, just try to + /* If FORCE, get the innermost elaborated scope. Otherwise, just try to get the first scope. */ gnat_scope = node->gnat_scope; while (Present (gnat_scope)) @@ -3058,7 +3058,6 @@ process_deferred_decl_context (bool forc } } - /* Return VALUE scaled by the biggest power-of-2 factor of EXPR. */ static unsigned int