From cd8ad45920aaf33a660b85878c572298faba06bf Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 12 Jun 2018 09:51:26 +0000 Subject: decl.c (variant_desc): Add AUX field. * 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. From-SVN: r261479 --- gcc/ada/ChangeLog | 18 +++++ gcc/ada/gcc-interface/decl.c | 136 ++++++++++++++++++++++++------------ gcc/ada/gcc-interface/utils.c | 51 ++++++++------ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gnat.dg/opt72_pkg.ads | 12 ++++ gcc/testsuite/gnat.dg/opt72a.adb | 12 ++++ gcc/testsuite/gnat.dg/opt72b.adb | 12 ++++ 7 files changed, 179 insertions(+), 67 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/opt72_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/opt72a.adb create mode 100644 gcc/testsuite/gnat.dg/opt72b.adb (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 91907fb..091ba23 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +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-11 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : Reuse the diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 2f8955b..a79cb00 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -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_entity, tree gnu_expr, bool definition) /* 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, const PTR rt2) 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_component_list, Entity_Id gnat_record_type, /* 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, vec subst_list, 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_variant_part, /* 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_variant_part, 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 gnat_new_type, { 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 gnat_new_type, 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 gnat_new_type, 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 gnat_new_type, 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 gnat_new_type, /* 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 gnat_new_type, /* 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 gnat_new_type, 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; + /* 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); - for (int i = 0; t; t = DECL_CHAIN (t), i++) - field_arr[i] = t; + /* 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 gnat_new_type, 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). */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index d415f49..992d568 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1054,12 +1054,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) 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_record, unsigned int max_align) 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, tree field_list, int rep_level, 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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b1e6944..56b6008 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-06-12 Eric Botcazou + + * gnat.dg/opt72a.ad[sb]: New test. + * gnat.dg/opt72_pkg.ads: New helper. + 2018-06-12 Tom de Vries * gcc.dg-selftests/dg-final.exp: New file. diff --git a/gcc/testsuite/gnat.dg/opt72_pkg.ads b/gcc/testsuite/gnat.dg/opt72_pkg.ads new file mode 100644 index 0000000..92255fb --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt72_pkg.ads @@ -0,0 +1,12 @@ +package Opt72_Pkg is + + type Rec is record + Flag : Boolean; + Size : Positive; + end record; + for Rec use record + Flag at 0 range 0 .. 0; + Size at 0 range 1 .. 31; + end record; + +end Opt72_Pkg; diff --git a/gcc/testsuite/gnat.dg/opt72a.adb b/gcc/testsuite/gnat.dg/opt72a.adb new file mode 100644 index 0000000..db1d28c --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt72a.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } +-- { dg-require-effective-target store_merge } +-- { dg-options "-O2 -fdump-tree-store-merging" } + +with Opt72_Pkg; use Opt72_Pkg; + +procedure Opt72a (X : not null access Rec; Size : Positive) is +begin + X.all := (Flag => True, Size => Size); +end; + +-- { dg-final { scan-tree-dump "Merging successful" "store-merging" } } diff --git a/gcc/testsuite/gnat.dg/opt72b.adb b/gcc/testsuite/gnat.dg/opt72b.adb new file mode 100644 index 0000000..e4a708b --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt72b.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } +-- { dg-require-effective-target store_merge } +-- { dg-options "-O2 -fdump-tree-store-merging" } + +with Opt72_Pkg; use Opt72_Pkg; + +procedure Opt72b (X : not null access Rec; Y : not null access Rec) is +begin + X.all := (Flag => True, Size => Y.Size); +end; + +-- { dg-final { scan-tree-dump "Merging successful" "store-merging" } } -- cgit v1.1