From patchwork Tue Jun 12 09:51:35 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 928213 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-479524-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="cuIwnjO+"; 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 414lXT03zBz9s1B for ; Tue, 12 Jun 2018 19:51:51 +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=n98ZWbPHPHpz9BFc qd0NwEu8B1H1M6WT3MYKY7NXGvM0SoYcDLcZNYb7pK2bW3iWlYknus0pOdxtpLhO wwvZx4msSzA6FXnzhcGxt7y5oI7YsOUceM3IkJKLK1coJVkhEdJhPuDfuuPaE5GB n8hGO0DSSMtvLGKrhd8Msc/+Z2c= 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=SJHsa541YrkGQtFA2SQHc8 famRY=; b=cuIwnjO+qK+9AtMPiil3/wz+YC9vcVG4zOobDRSxHOyv6UKcO3vFEt 3pN0TNWQ06MyjP8tt+4OjuITQAlq6j6w8Zht4JhFaUK5tKWEfjxgDCepwh4mTE9I Fg0taH3yJCIRe/tREStpniTpuSuT8/B/uKsS+tFP6BYjd8I6MsH5Y= Received: (qmail 55702 invoked by alias); 12 Jun 2018 09:51:43 -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 55690 invoked by uid 89); 12 Jun 2018 09:51:43 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.4 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=auxiliary, uniform, gigi 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, 12 Jun 2018 09:51:41 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 03DDF81399 for ; Tue, 12 Jun 2018 11:51:38 +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 MlEkiCROeu7U for ; Tue, 12 Jun 2018 11:51:37 +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 C35AD81397 for ; Tue, 12 Jun 2018 11:51:37 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Improve generated code for records with rep clauses Date: Tue, 12 Jun 2018 11:51:35 +0200 Message-ID: <2231556.koWN2aPMKh@polaris> MIME-Version: 1.0 This makes sure the handling of bit-fields is uniform in packed records or records with representation clause. Tested on x86-64/Linux, applied on mainline, 2018-06-12 Eric Botcazou * gcc-interface/decl.c (variant_desc): Add AUX field. (gnat_to_gnu_entity) : Do not call compute_record_mode directly. (reverse_sort_field_list): New static function. (components_to_record): Place the variant part at the beginning of the field list when there is an obvious order of increasing position. (build_variant_list): Initialize it. (create_variant_part_from): Do not call compute_record_mode directly. (copy_and_substitute_in_layout): Likewise. Always sort the fields with fixed position in order of increasing position, in the record and all the variants, in any. Call reverse_sort_field_list. * gcc-interface/utils.c (make_packable_type): Compute the sizes before calling finish_record_type. Do not call compute_record_mode directly. (finish_record_type): Overhaul final processing depending on REP_LEVEL and call finish_bitfield_layout if it is equal to one or two. 2018-06-12 Eric Botcazou * gnat.dg/opt72a.ad[sb]: New test. * gnat.dg/opt72_pkg.ads: New helper. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 261473) +++ gcc-interface/decl.c (working copy) @@ -123,6 +123,9 @@ typedef struct variant_desc_d { /* The type of the variant after transformation. */ tree new_type; + + /* The auxiliary data. */ + tree aux; } variant_desc; @@ -1927,7 +1930,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entit /* We will output additional debug info manually below. */ finish_record_type (gnu_type, gnu_field, 2, false); - compute_record_mode (gnu_type); TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; if (debug_info_p) @@ -7228,6 +7230,28 @@ compare_field_bitpos (const PTR rt1, con return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2)); } +/* Sort the LIST of fields in reverse order of increasing position. */ + +static tree +reverse_sort_field_list (tree list) +{ + const int len = list_length (list); + tree *field_arr = XALLOCAVEC (tree, len); + + for (int i = 0; list; list = DECL_CHAIN (list), i++) + field_arr[i] = list; + + qsort (field_arr, len, sizeof (tree), compare_field_bitpos); + + for (int i = 0; i < len; i++) + { + DECL_CHAIN (field_arr[i]) = list; + list = field_arr[i]; + } + + return list; +} + /* Reverse function from gnat_to_gnu_field: return the GNAT field present in either GNAT_COMPONENT_LIST or the discriminants of GNAT_RECORD_TYPE, and corresponding to the GNU tree GNU_FIELD. */ @@ -8037,7 +8061,23 @@ components_to_record (Node_Id gnat_compo /* Chain the variant part at the end of the field list. */ if (gnu_variant_part) - gnu_field_list = chainon (gnu_field_list, gnu_variant_part); + { + /* We make an exception if the variant part is at offset 0, has a fixed + size, and there is a single rep'ed field placed after it because, in + this case, there is an obvious order of increasing position. */ + if (variants_have_rep + && TREE_CODE (DECL_SIZE_UNIT (gnu_variant_part)) == INTEGER_CST + && gnu_rep_list + && gnu_field_list == gnu_rep_list + && !tree_int_cst_lt (DECL_FIELD_OFFSET (gnu_rep_list), + DECL_SIZE_UNIT (gnu_variant_part))) + { + DECL_CHAIN (gnu_variant_part) = gnu_field_list; + gnu_field_list = gnu_variant_part; + } + else + gnu_field_list = chainon (gnu_field_list, gnu_variant_part); + } if (cancel_alignment) SET_TYPE_ALIGN (gnu_record_type, 0); @@ -8527,7 +8567,8 @@ build_variant_list (tree qual_union_type if (!integer_zerop (qual)) { tree variant_type = TREE_TYPE (gnu_field), variant_subpart; - variant_desc v = { variant_type, gnu_field, qual, NULL_TREE }; + variant_desc v + = { variant_type, gnu_field, qual, NULL_TREE, NULL_TREE }; gnu_list.safe_push (v); @@ -9301,7 +9342,6 @@ create_variant_part_from (tree old_varia /* Finish up the new variant and create the field. */ finish_record_type (new_variant, nreverse (field_list), 2, debug_info_p); - compute_record_mode (new_variant); create_type_decl (TYPE_NAME (new_variant), new_variant, true, debug_info_p, Empty); @@ -9319,7 +9359,6 @@ create_variant_part_from (tree old_varia reverse the field list because VARIANT_LIST has been traversed in reverse order. */ finish_record_type (new_union_type, union_field_list, 2, debug_info_p); - compute_record_mode (new_union_type); create_type_decl (TYPE_NAME (new_union_type), new_union_type, true, debug_info_p, Empty); @@ -9417,7 +9456,8 @@ copy_and_substitute_in_layout (Entity_Id { const bool is_subtype = (Ekind (gnat_new_type) == E_Record_Subtype); tree gnu_field_list = NULL_TREE; - bool selected_variant, all_constant_pos = true; + tree gnu_variable_field_list = NULL_TREE; + bool selected_variant; vec gnu_variant_list; /* Look for REP and variant parts in the old type. */ @@ -9501,6 +9541,7 @@ copy_and_substitute_in_layout (Entity_Id tree gnu_context = DECL_CONTEXT (gnu_old_field); tree gnu_field, gnu_field_type, gnu_size, gnu_pos; tree gnu_cont_type, gnu_last = NULL_TREE; + variant_desc *v = NULL; /* If the type is the same, retrieve the GCC type from the old field to take into account possible adjustments. */ @@ -9549,7 +9590,6 @@ copy_and_substitute_in_layout (Entity_Id gnu_cont_type = gnu_new_type; else { - variant_desc *v; unsigned int i; tree rep_part; @@ -9562,7 +9602,7 @@ copy_and_substitute_in_layout (Entity_Id if (v) gnu_cont_type = selected_variant ? gnu_new_type : v->new_type; else - /* The front-end may pass us "ghost" components if it fails to + /* The front-end may pass us zombie components if it fails to recognize that a constrain statically selects a particular variant. Discard them. */ continue; @@ -9578,8 +9618,16 @@ copy_and_substitute_in_layout (Entity_Id /* If the context is a variant, put it in the new variant directly. */ if (gnu_cont_type != gnu_new_type) { - DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); - TYPE_FIELDS (gnu_cont_type) = gnu_field; + if (TREE_CODE (gnu_pos) == INTEGER_CST) + { + DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); + TYPE_FIELDS (gnu_cont_type) = gnu_field; + } + else + { + DECL_CHAIN (gnu_field) = v->aux; + v->aux = gnu_field; + } } /* To match the layout crafted in components_to_record, if this is @@ -9598,12 +9646,18 @@ copy_and_substitute_in_layout (Entity_Id /* Otherwise, put it after the other fields. */ else { - DECL_CHAIN (gnu_field) = gnu_field_list; - gnu_field_list = gnu_field; - if (!gnu_last) - gnu_last = gnu_field; - if (TREE_CODE (gnu_pos) != INTEGER_CST) - all_constant_pos = false; + if (TREE_CODE (gnu_pos) == INTEGER_CST) + { + DECL_CHAIN (gnu_field) = gnu_field_list; + gnu_field_list = gnu_field; + if (!gnu_last) + gnu_last = gnu_field; + } + else + { + DECL_CHAIN (gnu_field) = gnu_variable_field_list; + gnu_variable_field_list = gnu_field; + } } /* For a stored discriminant in a derived type, replace the field. */ @@ -9616,31 +9670,32 @@ copy_and_substitute_in_layout (Entity_Id save_gnu_tree (gnat_field, gnu_field, false); } - /* If there is no variant list or a selected variant and the fields all have - constant position, put them in order of increasing position to match that - of constant CONSTRUCTORs. */ - if ((!gnu_variant_list.exists () || selected_variant) && all_constant_pos) - { - const int len = list_length (gnu_field_list); - tree *field_arr = XALLOCAVEC (tree, len), t = gnu_field_list; - - for (int i = 0; t; t = DECL_CHAIN (t), i++) - field_arr[i] = t; + /* Put the fields with fixed position in order of increasing position. */ + if (gnu_field_list) + gnu_field_list = reverse_sort_field_list (gnu_field_list); + + /* Put the fields with variable position at the end. */ + if (gnu_variable_field_list) + gnu_field_list = chainon (gnu_variable_field_list, gnu_field_list); - qsort (field_arr, len, sizeof (tree), compare_field_bitpos); + /* If there is a variant list and no selected variant, we need to create the + nest of variant parts from the old nest. */ + if (gnu_variant_list.exists () && !selected_variant) + { + variant_desc *v; + unsigned int i; - gnu_field_list = NULL_TREE; - for (int i = 0; i < len; i++) + /* Same processing as above for the fields of each variant. */ + FOR_EACH_VEC_ELT (gnu_variant_list, i, v) { - DECL_CHAIN (field_arr[i]) = gnu_field_list; - gnu_field_list = field_arr[i]; + if (TYPE_FIELDS (v->new_type)) + TYPE_FIELDS (v->new_type) + = reverse_sort_field_list (TYPE_FIELDS (v->new_type)); + if (v->aux) + TYPE_FIELDS (v->new_type) + = chainon (v->aux, TYPE_FIELDS (v->new_type)); } - } - /* If there is a variant list and no selected variant, we need to create the - nest of variant parts from the old nest. */ - else if (gnu_variant_list.exists () && !selected_variant) - { tree new_variant_part = create_variant_part_from (gnu_variant_part, gnu_variant_list, gnu_new_type, gnu_pos_list, @@ -9652,17 +9707,10 @@ copy_and_substitute_in_layout (Entity_Id gnu_variant_list.release (); gnu_subst_list.release (); - gnu_field_list = nreverse (gnu_field_list); - /* If NEW_TYPE is a subtype, it inherits all the attributes from OLD_TYPE. Otherwise sizes and alignment must be computed independently. */ - if (is_subtype) - { - finish_record_type (gnu_new_type, gnu_field_list, 2, debug_info_p); - compute_record_mode (gnu_new_type); - } - else - finish_record_type (gnu_new_type, gnu_field_list, 1, debug_info_p); + finish_record_type (gnu_new_type, nreverse (gnu_field_list), + is_subtype ? 2 : 1, debug_info_p); /* Now go through the entities again looking for Itypes that we have not yet elaborated (e.g. Etypes of fields that have Original_Components). */ Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 261473) +++ gcc-interface/utils.c (working copy) @@ -1054,12 +1054,6 @@ make_packable_type (tree type, bool in_r new_field_list = new_field; } - finish_record_type (new_type, nreverse (new_field_list), 2, false); - relate_alias_sets (new_type, type, ALIAS_SET_COPY); - if (TYPE_STUB_DECL (type)) - SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type), - DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type))); - /* If this is a padding record, we never want to make the size smaller than what was specified. For QUAL_UNION_TYPE, also copy the size. */ if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE) @@ -1077,7 +1071,11 @@ make_packable_type (tree type, bool in_r if (!TYPE_CONTAINS_TEMPLATE_P (type)) SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type)); - compute_record_mode (new_type); + finish_record_type (new_type, nreverse (new_field_list), 2, false); + relate_alias_sets (new_type, type, ALIAS_SET_COPY); + if (TYPE_STUB_DECL (type)) + SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type), + DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type))); /* Try harder to get a packable type if necessary, for example in case the record itself contains a BLKmode field. */ @@ -1951,33 +1949,40 @@ finish_record_type (tree record_type, tr if (code == QUAL_UNION_TYPE) nreverse (field_list); - if (rep_level < 2) + /* We need to set the regular sizes if REP_LEVEL is one. */ + if (rep_level == 1) { /* If this is a padding record, we never want to make the size smaller than what was specified in it, if any. */ if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type)) size = TYPE_SIZE (record_type); + tree size_unit = had_size_unit + ? TYPE_SIZE_UNIT (record_type) + : convert (sizetype, + size_binop (CEIL_DIV_EXPR, size, + bitsize_unit_node)); + const unsigned int align = TYPE_ALIGN (record_type); + + TYPE_SIZE (record_type) = variable_size (round_up (size, align)); + TYPE_SIZE_UNIT (record_type) + = variable_size (round_up (size_unit, align / BITS_PER_UNIT)); + } + + /* We need to set the Ada size if REP_LEVEL is zero or one. */ + if (rep_level < 2) + { /* Now set any of the values we've just computed that apply. */ if (!TYPE_FAT_POINTER_P (record_type) && !TYPE_CONTAINS_TEMPLATE_P (record_type)) SET_TYPE_ADA_SIZE (record_type, ada_size); + } - if (rep_level > 0) - { - tree size_unit = had_size_unit - ? TYPE_SIZE_UNIT (record_type) - : convert (sizetype, - size_binop (CEIL_DIV_EXPR, size, - bitsize_unit_node)); - unsigned int align = TYPE_ALIGN (record_type); - - TYPE_SIZE (record_type) = variable_size (round_up (size, align)); - TYPE_SIZE_UNIT (record_type) - = variable_size (round_up (size_unit, align / BITS_PER_UNIT)); - - compute_record_mode (record_type); - } + /* We need to set the mode if REP_LEVEL is one or two. */ + if (rep_level > 0) + { + compute_record_mode (record_type); + finish_bitfield_layout (record_type); } /* Reset the TYPE_MAX_ALIGN field since it's private to gigi. */