From b1a785fb5e5ada5ffb07640bb8fe0d15f3bddb68 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 20 Nov 2011 10:03:11 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): Adjust call to components_to_record. * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust call to components_to_record. (components_to_record): Add FIRST_FREE_POS parameter. For the variant part, reuse enclosing union even if there is a representation clause on the Unchecked_Union. If there is a variant part, compute the new first free position, if any. Adjust call to self. Use a single field directly only if it hasn't got a representation clause or is placed at offset zero. Create the variant part at offset 0 if all the fields down to this level have a rep clause. Do not chain the variant part immediately and adjust downstream. Do not test ALL_REP before moving the fields without rep clause to the previous level. Call create_rep_part to create the REP part and force a minimum size on it if necessary. Do not chain it immediately. Create a fake REP part if there are fields without rep clause that need to be laid out starting from FIRST_FREE_POS. At the end, chain the REP part and then the variant part. (create_rep_part): New function. (get_rep_part): Minor tweak. * gcc-interface/utils.c (tree_code_for_record_type): Minor tweak. From-SVN: r181526 --- gcc/ada/ChangeLog | 22 ++++ gcc/ada/gcc-interface/decl.c | 179 ++++++++++++++++++-------- gcc/ada/gcc-interface/utils.c | 16 +-- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gnat.dg/discr32.adb | 21 +++ gcc/testsuite/gnat.dg/discr32_pkg.ads | 24 ++++ 6 files changed, 201 insertions(+), 66 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/discr32.adb create mode 100644 gcc/testsuite/gnat.dg/discr32_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ba92e3b9ae6..3e9e7ea45cd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2011-11-20 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust + call to components_to_record. + (components_to_record): Add FIRST_FREE_POS parameter. For the variant + part, reuse enclosing union even if there is a representation clause + on the Unchecked_Union. If there is a variant part, compute the new + first free position, if any. Adjust call to self. Use a single field + directly only if it hasn't got a representation clause or is placed at + offset zero. Create the variant part at offset 0 if all the fields + down to this level have a rep clause. Do not chain the variant part + immediately and adjust downstream. + Do not test ALL_REP before moving the fields without rep clause to the + previous level. Call create_rep_part to create the REP part and force + a minimum size on it if necessary. Do not chain it immediately. + Create a fake REP part if there are fields without rep clause that need + to be laid out starting from FIRST_FREE_POS. + At the end, chain the REP part and then the variant part. + (create_rep_part): New function. + (get_rep_part): Minor tweak. + * gcc-interface/utils.c (tree_code_for_record_type): Minor tweak. + 2011-11-18 Iain Sandoe PR target/50678 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index d7ca5dbbe6e..12971a63038 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -160,7 +160,7 @@ static bool compile_time_known_address_p (Node_Id); static bool cannot_be_superflat_p (Node_Id); static bool constructor_address_p (tree); static void components_to_record (tree, Node_Id, tree, int, bool, bool, bool, - bool, bool, bool, bool, tree *); + bool, bool, bool, bool, tree, tree *); static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); static tree build_position_list (tree, bool, tree, tree, unsigned int, tree); @@ -176,6 +176,7 @@ static unsigned int ceil_alignment (unsigned HOST_WIDE_INT); static void check_ok_for_atomic (tree, Entity_Id, bool); static tree create_field_decl_from (tree, tree, tree, tree, tree, VEC(subst_pair,heap) *); +static tree create_rep_part (tree, tree, tree); static tree get_rep_part (tree); static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree, tree, VEC(subst_pair,heap) *); @@ -3048,7 +3049,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field_list, packed, definition, false, all_rep, is_unchecked_union, debug_info_p, false, OK_To_Reorder_Components (gnat_entity), - NULL); + all_rep ? NULL_TREE : bitsize_zero_node, NULL); /* If it is passed by reference, force BLKmode to ensure that objects of this type will always be put in memory. */ @@ -7096,6 +7097,10 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) REORDER is true if we are permitted to reorder components of this type. + FIRST_FREE_POS, if nonzero, is the first (lowest) free field position in + the outer record type down to this variant level. It is nonzero only if + all the fields down to this level have a rep clause and ALL_REP is false. + P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field with a rep clause is to be added; in this case, that is all that should be done with such fields. */ @@ -7106,12 +7111,13 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, bool cancel_alignment, bool all_rep, bool unchecked_union, bool debug_info, bool maybe_unused, bool reorder, - tree *p_gnu_rep_list) + tree first_free_pos, tree *p_gnu_rep_list) { bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool layout_with_rep = false; Node_Id component_decl, variant_part; tree gnu_field, gnu_next, gnu_last; + tree gnu_rep_part = NULL_TREE; tree gnu_variant_part = NULL_TREE; tree gnu_rep_list = NULL_TREE; tree gnu_var_list = NULL_TREE; @@ -7185,7 +7191,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))), "XVN"); tree gnu_union_type, gnu_union_name; - tree gnu_variant_list = NULL_TREE; + tree this_first_free_pos, gnu_variant_list = NULL_TREE; if (TREE_CODE (gnu_name) == TYPE_DECL) gnu_name = DECL_NAME (gnu_name); @@ -7193,12 +7199,10 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_union_name = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name)); - /* Reuse an enclosing union if all fields are in the variant part - and there is no representation clause on the record, to match - the layout of C unions. There is an associated check below. */ - if (!gnu_field_list - && TREE_CODE (gnu_record_type) == UNION_TYPE - && !TYPE_PACKED (gnu_record_type)) + /* Reuse the enclosing union if this is an Unchecked_Union whose fields + are all in the variant part, to match the layout of C unions. There + is an associated check below. */ + if (TREE_CODE (gnu_record_type) == UNION_TYPE) gnu_union_type = gnu_record_type; else { @@ -7210,6 +7214,29 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type); } + /* If all the fields down to this level have a rep clause, find out + whether all the fields at this level also have one. If so, then + compute the new first free position to be passed downward. */ + this_first_free_pos = first_free_pos; + if (this_first_free_pos) + { + for (gnu_field = gnu_field_list; + gnu_field; + gnu_field = DECL_CHAIN (gnu_field)) + if (DECL_FIELD_OFFSET (gnu_field)) + { + tree pos = bit_position (gnu_field); + if (!tree_int_cst_lt (pos, this_first_free_pos)) + this_first_free_pos + = size_binop (PLUS_EXPR, pos, DECL_SIZE (gnu_field)); + } + else + { + this_first_free_pos = NULL_TREE; + break; + } + } + for (variant = First_Non_Pragma (Variants (variant_part)); Present (variant); variant = Next_Non_Pragma (variant)) @@ -7231,8 +7258,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type); /* Similarly, if the outer record has a size specified and all - fields have record rep clauses, we can propagate the size - into the variant part. */ + the fields have a rep clause, we can propagate the size. */ if (all_rep_and_size) { TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type); @@ -7244,20 +7270,24 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, we aren't sure to really use it at this point, see below. */ components_to_record (gnu_variant_type, Component_List (variant), NULL_TREE, packed, definition, - !all_rep_and_size, all_rep, - unchecked_union, debug_info, - true, reorder, &gnu_rep_list); + !all_rep_and_size, all_rep, unchecked_union, + debug_info, true, reorder, this_first_free_pos, + all_rep || this_first_free_pos + ? NULL : &gnu_rep_list); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); - Set_Present_Expr (variant, annotate_value (gnu_qual)); - /* If this is an Unchecked_Union and we have exactly one field, - use this field directly to match the layout of C unions. */ - if (unchecked_union - && TYPE_FIELDS (gnu_variant_type) - && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type))) - gnu_field = TYPE_FIELDS (gnu_variant_type); + /* If this is an Unchecked_Union whose fields are all in the variant + part and we have a single field with no representation clause or + placed at offset zero, use the field directly to match the layout + of C unions. */ + if (TREE_CODE (gnu_record_type) == UNION_TYPE + && (gnu_field = TYPE_FIELDS (gnu_variant_type)) != NULL_TREE + && !DECL_CHAIN (gnu_field) + && (!DECL_FIELD_OFFSET (gnu_field) + || integer_zerop (bit_position (gnu_field)))) + DECL_CONTEXT (gnu_field) = gnu_union_type; else { /* Deal with packedness like in gnat_to_gnu_field. */ @@ -7328,15 +7358,18 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_variant_part = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, all_rep ? TYPE_SIZE (gnu_union_type) : 0, - all_rep ? bitsize_zero_node : 0, + all_rep || this_first_free_pos + ? bitsize_zero_node : 0, union_field_packed, 0); DECL_INTERNAL_P (gnu_variant_part) = 1; - DECL_CHAIN (gnu_variant_part) = gnu_field_list; - gnu_field_list = gnu_variant_part; } } + /* From now on, a zero FIRST_FREE_POS is totally useless. */ + if (first_free_pos && integer_zerop (first_free_pos)) + first_free_pos = NULL_TREE; + /* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are permitted to reorder components, self-referential sizes or variable sizes. If they do, pull them out and put them onto the appropriate list. We have @@ -7368,33 +7401,24 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, continue; } - if (reorder) + /* Reorder non-internal fields with non-fixed size. */ + if (reorder + && !DECL_INTERNAL_P (gnu_field) + && !(DECL_SIZE (gnu_field) + && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST)) { - /* Pull out the variant part and put it onto GNU_SELF_LIST. */ - if (gnu_field == gnu_variant_part) + tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field)); + + if (CONTAINS_PLACEHOLDER_P (type_size)) { MOVE_FROM_FIELD_LIST_TO (gnu_self_list); continue; } - /* Skip internal fields and fields with fixed size. */ - if (!DECL_INTERNAL_P (gnu_field) - && !(DECL_SIZE (gnu_field) - && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST)) + if (TREE_CODE (type_size) != INTEGER_CST) { - tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field)); - - if (CONTAINS_PLACEHOLDER_P (type_size)) - { - MOVE_FROM_FIELD_LIST_TO (gnu_self_list); - continue; - } - - if (TREE_CODE (type_size) != INTEGER_CST) - { - MOVE_FROM_FIELD_LIST_TO (gnu_var_list); - continue; - } + MOVE_FROM_FIELD_LIST_TO (gnu_var_list); + continue; } } @@ -7416,14 +7440,14 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = chainon (nreverse (gnu_self_list), chainon (nreverse (gnu_var_list), gnu_field_list)); - /* If we have any fields in our rep'ed field list and it is not the case that - all the fields in the record have rep clauses and P_REP_LIST is nonzero, - set it and ignore these fields. */ - if (gnu_rep_list && p_gnu_rep_list && !all_rep) + /* If P_REP_LIST is nonzero, this means that we are asked to move the fields + in our REP list to the previous level because this level needs them in + order to do a correct layout, i.e. avoid having overlapping fields. */ + if (p_gnu_rep_list && gnu_rep_list) *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_rep_list); /* Otherwise, sort the fields by bit position and put them into their own - record, before the others, if we also have fields without rep clauses. */ + record, before the others, if we also have fields without rep clause. */ else if (gnu_rep_list) { tree gnu_rep_type @@ -7451,11 +7475,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, if (gnu_field_list) { finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info); - gnu_field - = create_field_decl (get_identifier ("REP"), gnu_rep_type, - gnu_record_type, NULL_TREE, NULL_TREE, 0, 1); - DECL_INTERNAL_P (gnu_field) = 1; - gnu_field_list = chainon (gnu_field_list, gnu_field); + + /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields + without rep clause are laid out starting from this position. + Therefore, we force it as a minimal size on the REP part. */ + gnu_rep_part + = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos); } else { @@ -7464,6 +7489,28 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, } } + /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields without + rep clause are laid out starting from this position. Therefore, if we + have not already done so, we create a fake REP part with this size. */ + if (first_free_pos && !layout_with_rep && !gnu_rep_part) + { + tree gnu_rep_type = make_node (RECORD_TYPE); + finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info); + gnu_rep_part + = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos); + } + + /* Now chain the REP part at the end of the reversed field list. */ + if (gnu_rep_part) + gnu_field_list = chainon (gnu_field_list, gnu_rep_part); + + /* And the variant part at the beginning. */ + if (gnu_variant_part) + { + DECL_CHAIN (gnu_variant_part) = gnu_field_list; + gnu_field_list = gnu_variant_part; + } + if (cancel_alignment) TYPE_ALIGN (gnu_record_type) = 0; @@ -8567,6 +8614,24 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type, return new_field; } +/* Create the REP part of RECORD_TYPE with REP_TYPE. If MIN_SIZE is nonzero, + it is the minimal size the REP_PART must have. */ + +static tree +create_rep_part (tree rep_type, tree record_type, tree min_size) +{ + tree field; + + if (min_size && !tree_int_cst_lt (TYPE_SIZE (rep_type), min_size)) + min_size = NULL_TREE; + + field = create_field_decl (get_identifier ("REP"), rep_type, record_type, + min_size, bitsize_zero_node, 0, 1); + DECL_INTERNAL_P (field) = 1; + + return field; +} + /* Return the REP part of RECORD_TYPE, if any. Otherwise return NULL. */ static tree @@ -8575,10 +8640,10 @@ get_rep_part (tree record_type) tree field = TYPE_FIELDS (record_type); /* The REP part is the first field, internal, another record, and its name - doesn't start with an underscore (i.e. is not generated by the FE). */ + starts with an 'R'. */ if (DECL_INTERNAL_P (field) && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE - && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_') + && IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R') return field; return NULL_TREE; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 73657528a8a..a71a3d28878 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -4744,19 +4744,17 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) enum tree_code tree_code_for_record_type (Entity_Id gnat_type) { - Node_Id component_list - = Component_List (Type_Definition - (Declaration_Node - (Implementation_Base_Type (gnat_type)))); - Node_Id component; - - /* Make this a UNION_TYPE unless it's either not an Unchecked_Union or - we have a non-discriminant field outside a variant. In either case, - it's a RECORD_TYPE. */ + Node_Id component_list, component; + /* Return UNION_TYPE if it's an Unchecked_Union whose non-discriminant + fields are all in the variant part. Otherwise, return RECORD_TYPE. */ if (!Is_Unchecked_Union (gnat_type)) return RECORD_TYPE; + gnat_type = Implementation_Base_Type (gnat_type); + component_list + = Component_List (Type_Definition (Declaration_Node (gnat_type))); + for (component = First_Non_Pragma (Component_Items (component_list)); Present (component); component = Next_Non_Pragma (component)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ef00522d131..6c85640c261 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-11-20 Eric Botcazou + + * gnat.dg/discr32.adb: New test. + * gnat.dg/discr32_pkg.ads: New helper. + 2011-11-20 Nathan Sidwell PR gcov-profile/51113 diff --git a/gcc/testsuite/gnat.dg/discr32.adb b/gcc/testsuite/gnat.dg/discr32.adb new file mode 100644 index 00000000000..830a6dfd59a --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr32.adb @@ -0,0 +1,21 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with Discr32_Pkg; use Discr32_Pkg; + +procedure Discr32 is +begin + + if R1'Object_Size /= 32 then + raise Program_Error; + end if; + + if R2'Object_Size /= R'Object_Size then + raise Program_Error; + end if; + + if R3'Object_Size /= 64 then + raise Program_Error; + end if; + +end; diff --git a/gcc/testsuite/gnat.dg/discr32_pkg.ads b/gcc/testsuite/gnat.dg/discr32_pkg.ads new file mode 100644 index 00000000000..f1761e4b5e5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr32_pkg.ads @@ -0,0 +1,24 @@ +package Discr32_Pkg is + + type Enum is (One, Two, Three); + + type R (D : Enum) is record + case D is + when One => B : Boolean; + when Two => I : Integer; + when Three => F : Float; + end case; + end record; + + for R use record + D at 0 range 0 .. 1; + B at 1 range 0 .. 0; + I at 4 range 0 .. 31 + 128; +-- F at 4 range 0 .. 31; + end record; + + subtype R1 is R (One); + subtype R2 is R (Two); + subtype R3 is R (Three); + +end Discr32_Pkg; -- 2.30.2