From patchwork Sat Jun 29 08:10:45 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 1124727 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-504015-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com 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 45bRCz6Zlrz9s3l for ; Sat, 29 Jun 2019 18:11:03 +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=RAfSM1w3Mu0JGzYv 274FQtgXeSj/4Zre/HEHnaNIbE6zCBPomlzA/Lc17ADLLrG5Telxd5PoigQ0LPgk aluptXOO8roC2XXZb/2+OZeHSgpNufjpjyR1RHX8/36x96fS+Mx4+6xc+DNSOTiv byrZwjwgqWqe3VTLrOkiSISvcmI= 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=Xr6IGBe4/qn4AGM5e8lOFM De7m0=; b=Q+oCSwnP2sKtwLftYajGmpIYfrsQqAYUe9lafsnxfBQjQySlR4DA4V vB0g4tdPE2dM+2i3PuLUjbNesAivYRv8myQBxodZbGXw2aN/SUMOxRrLVhcsGm7Q CYx3b6H5Gwn0RuIIaKzfjB3hcu14YwhxS71b559J2vBC14T3qDOiw= Received: (qmail 23453 invoked by alias); 29 Jun 2019 08:10:55 -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 23424 invoked by uid 89); 29 Jun 2019 08:10:52 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-6.5 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.1 spammy=fat, sk:type_co, smallest 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; Sat, 29 Jun 2019 08:10:49 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 999FF8138F for ; Sat, 29 Jun 2019 10:10:47 +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 WIDqvYO3PEPv for ; Sat, 29 Jun 2019 10:10:47 +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 6722381339 for ; Sat, 29 Jun 2019 10:10:47 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix inconsistent Value_Size for Strict_Alignment types Date: Sat, 29 Jun 2019 10:10:45 +0200 Message-ID: <9526085.TaSYqGNSro@polaris> MIME-Version: 1.0 In Ada we have what we call strict-alignment types, i.e. types that can never be misaligned in record types. They are exactly the types which contain an aliased field, either explicitly or implicitly (i.e. tagged types). For them, by definition of 'Size in the Ada RM, this 'Size must be equal to the natural size, which means that 'Value_Size = 'Object_Size for GNAT. Tested on x86-64/Linux, applied on mainline. 2019-06-29 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : If the type requires strict alignment, then set the RM size to the type size. Rework handling of alignment and sizes of tagged types in ASIS mode. (validate_size): Rename local variable and remove special handling for strict-alignment types. * gcc-interface/utils.c (finish_record_type): Constify local variables and use properly typed constants. 2019-06-29 Eric Botcazou * gnat.dg/specs/size_clause3.ads: Adjust error message. Index: ada/gcc-interface/decl.c =================================================================== --- ada/gcc-interface/decl.c (revision 272819) +++ ada/gcc-interface/decl.c (working copy) @@ -3004,9 +3004,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit { SET_TYPE_ALIGN (gnu_type, 0); - /* If a type needs strict alignment, the minimum size will be the - type size instead of the RM size (see validate_size). Cap the - alignment lest it causes this type size to become too large. */ + /* If a type needs strict alignment, then its type size will also + be the RM size (see below). Cap the alignment if needed, lest + it may cause this type size to become too large. */ if (Strict_Alignment (gnat_entity) && Known_RM_Size (gnat_entity)) { unsigned int max_size = UI_To_Int (RM_Size (gnat_entity)); @@ -3283,6 +3283,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit compute_record_mode (gnu_type); } + /* If the type needs strict alignment, then no object of the type + may have a size smaller than the natural size, which means that + the RM size of the type is equal to the type size. */ + if (Strict_Alignment (gnat_entity)) + SET_TYPE_ADA_SIZE (gnu_type, TYPE_SIZE (gnu_type)); + /* If there are entities in the chain corresponding to components that we did not elaborate, ensure we elaborate their types if they are Itypes. */ @@ -4187,7 +4193,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entit already defined so we cannot pass true for IN_PLACE here. */ process_attributes (&gnu_type, &attr_list, false, gnat_entity); - /* ??? Don't set the size for a String_Literal since it is either + /* See if a size was specified, by means of either an Object_Size or + a regular Size clause, and validate it if so. + + ??? Don't set the size for a String_Literal since it is either confirming or we don't handle it properly (if the low bound is non-constant). */ if (!gnu_size && kind != E_String_Literal_Subtype) @@ -4309,49 +4318,44 @@ gnat_to_gnu_entity (Entity_Id gnat_entit /* If we are just annotating types and the type is tagged, the tag and the parent components are not generated by the front-end so - alignment and sizes must be adjusted if there is no rep clause. */ - if (type_annotate_only - && Is_Tagged_Type (gnat_entity) - && Unknown_RM_Size (gnat_entity) - && !VOID_TYPE_P (gnu_type) - && (!TYPE_FIELDS (gnu_type) - || integer_zerop (bit_position (TYPE_FIELDS (gnu_type))))) + alignment and sizes must be adjusted. */ + if (type_annotate_only && Is_Tagged_Type (gnat_entity)) { - tree offset; - - if (Is_Derived_Type (gnat_entity)) + const bool derived_p = Is_Derived_Type (gnat_entity); + const Entity_Id gnat_parent + = derived_p ? Etype (Base_Type (gnat_entity)) : Empty; + const unsigned int inherited_align + = derived_p + ? UI_To_Int (Alignment (gnat_parent)) * BITS_PER_UNIT + : POINTER_SIZE; + const unsigned int align + = MAX (TYPE_ALIGN (gnu_type), inherited_align); + + Set_Alignment (gnat_entity, UI_From_Int (align / BITS_PER_UNIT)); + + /* If there is neither size clause nor representation clause, the + sizes need to be adjusted. */ + if (Unknown_RM_Size (gnat_entity) + && !VOID_TYPE_P (gnu_type) + && (!TYPE_FIELDS (gnu_type) + || integer_zerop (bit_position (TYPE_FIELDS (gnu_type))))) { - Entity_Id gnat_parent = Etype (Base_Type (gnat_entity)); - offset = UI_To_gnu (Esize (gnat_parent), bitsizetype); - Set_Alignment (gnat_entity, Alignment (gnat_parent)); + tree offset + = derived_p + ? UI_To_gnu (Esize (gnat_parent), bitsizetype) + : bitsize_int (POINTER_SIZE); + if (TYPE_FIELDS (gnu_type)) + offset + = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type))); + gnu_size = size_binop (PLUS_EXPR, gnu_size, offset); } - else - { - unsigned int align - = MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT; - offset = bitsize_int (POINTER_SIZE); - Set_Alignment (gnat_entity, UI_From_Int (align)); - } - - if (TYPE_FIELDS (gnu_type)) - offset - = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type))); - - gnu_size = size_binop (PLUS_EXPR, gnu_size, offset); - gnu_size = round_up (gnu_size, POINTER_SIZE); - Uint uint_size = annotate_value (gnu_size); - Set_RM_Size (gnat_entity, uint_size); - Set_Esize (gnat_entity, uint_size); - } - /* If there is a rep clause, only adjust alignment and Esize. */ - else if (type_annotate_only && Is_Tagged_Type (gnat_entity)) - { - unsigned int align - = MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT; - Set_Alignment (gnat_entity, UI_From_Int (align)); - gnu_size = round_up (gnu_size, POINTER_SIZE); + gnu_size = round_up (gnu_size, align); Set_Esize (gnat_entity, annotate_value (gnu_size)); + + /* Tagged types are Strict_Alignment so RM_Size = Esize. */ + if (Unknown_RM_Size (gnat_entity)) + Set_RM_Size (gnat_entity, Esize (gnat_entity)); } /* Otherwise no adjustment is needed. */ @@ -8732,7 +8736,7 @@ validate_size (Uint uint_size, tree gnu_ enum tree_code kind, bool component_p, bool zero_ok) { Node_Id gnat_error_node; - tree type_size, size; + tree old_size, size; /* Return 0 if no size was specified. */ if (uint_size == No_Uint) @@ -8797,17 +8801,11 @@ validate_size (Uint uint_size, tree gnu_ && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size); - if (kind == VAR_DECL - /* If a type needs strict alignment, a component of this type in - a packed record cannot be packed and thus uses the type size. */ - || (kind == TYPE_DECL && Strict_Alignment (gnat_object))) - type_size = TYPE_SIZE (gnu_type); - else - type_size = rm_size (gnu_type); + old_size = (kind == VAR_DECL ? TYPE_SIZE (gnu_type) : rm_size (gnu_type)); - /* Modify the size of a discriminated type to be the maximum size. */ - if (type_size && CONTAINS_PLACEHOLDER_P (type_size)) - type_size = max_size (type_size, true); + /* If the old size is self-referential, get the maximum size. */ + if (CONTAINS_PLACEHOLDER_P (old_size)) + old_size = max_size (old_size, true); /* If this is an access type or a fat pointer, the minimum size is that given by the smallest integral mode that's valid for pointers. */ @@ -8816,23 +8814,23 @@ validate_size (Uint uint_size, tree gnu_ scalar_int_mode p_mode = NARROWEST_INT_MODE; while (!targetm.valid_pointer_mode (p_mode)) p_mode = GET_MODE_WIDER_MODE (p_mode).require (); - type_size = bitsize_int (GET_MODE_BITSIZE (p_mode)); + old_size = bitsize_int (GET_MODE_BITSIZE (p_mode)); } /* Issue an error either if the default size of the object isn't a constant or if the new size is smaller than it. */ - if (TREE_CODE (type_size) != INTEGER_CST - || TREE_OVERFLOW (type_size) - || tree_int_cst_lt (size, type_size)) + if (TREE_CODE (old_size) != INTEGER_CST + || TREE_OVERFLOW (old_size) + || tree_int_cst_lt (size, old_size)) { if (component_p) post_error_ne_tree ("component size for& too small{, minimum allowed is ^}", - gnat_error_node, gnat_object, type_size); + gnat_error_node, gnat_object, old_size); else post_error_ne_tree ("size for& too small{, minimum allowed is ^}", - gnat_error_node, gnat_object, type_size); + gnat_error_node, gnat_object, old_size); return NULL_TREE; } Index: ada/gcc-interface/utils.c =================================================================== --- ada/gcc-interface/utils.c (revision 272810) +++ ada/gcc-interface/utils.c (working copy) @@ -1859,13 +1859,18 @@ void finish_record_type (tree record_type, tree field_list, int rep_level, bool debug_info_p) { - enum tree_code code = TREE_CODE (record_type); + const enum tree_code orig_code = TREE_CODE (record_type); + const bool had_size = TYPE_SIZE (record_type) != NULL_TREE; + const bool had_size_unit = TYPE_SIZE_UNIT (record_type) != NULL_TREE; + const bool had_align = TYPE_ALIGN (record_type) > 0; + /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE + out just like a UNION_TYPE, since the size will be fixed. */ + const enum tree_code code + = (orig_code == QUAL_UNION_TYPE && rep_level > 0 && had_size + ? UNION_TYPE : orig_code); tree name = TYPE_IDENTIFIER (record_type); tree ada_size = bitsize_zero_node; tree size = bitsize_zero_node; - bool had_size = TYPE_SIZE (record_type) != 0; - bool had_size_unit = TYPE_SIZE_UNIT (record_type) != 0; - bool had_align = TYPE_ALIGN (record_type) != 0; tree field; TYPE_FIELDS (record_type) = field_list; @@ -1878,26 +1883,21 @@ finish_record_type (tree record_type, tr that just means some initializations; otherwise, layout the record. */ if (rep_level > 0) { - SET_TYPE_ALIGN (record_type, MAX (BITS_PER_UNIT, - TYPE_ALIGN (record_type))); - - if (!had_size_unit) - TYPE_SIZE_UNIT (record_type) = size_zero_node; + if (TYPE_ALIGN (record_type) < BITS_PER_UNIT) + SET_TYPE_ALIGN (record_type, BITS_PER_UNIT); if (!had_size) TYPE_SIZE (record_type) = bitsize_zero_node; - /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE - out just like a UNION_TYPE, since the size will be fixed. */ - else if (code == QUAL_UNION_TYPE) - code = UNION_TYPE; + if (!had_size_unit) + TYPE_SIZE_UNIT (record_type) = size_zero_node; } else { /* Ensure there isn't a size already set. There can be in an error case where there is a rep clause but all fields have errors and no longer have a position. */ - TYPE_SIZE (record_type) = 0; + TYPE_SIZE (record_type) = NULL_TREE; /* Ensure we use the traditional GCC layout for bitfields when we need to pack the record type or have a representation clause. The other Index: testsuite/gnat.dg/specs/size_clause3.ads =================================================================== --- testsuite/gnat.dg/specs/size_clause3.ads (revision 272819) +++ testsuite/gnat.dg/specs/size_clause3.ads (working copy) @@ -14,7 +14,7 @@ package Size_Clause3 is rr : R1; -- size must be 40 end record; for S1 use record - rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased or tagged" } + rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" } end record; -- The record is explicitly given alignment 1 so its real type is 40. @@ -44,7 +44,7 @@ package Size_Clause3 is rr : R3; -- size must be 40 end record; for S3 use record - rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased or tagged" } + rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" } end record; end Size_Clause3;