From: Pierre-Marie de Rodat Date: Thu, 17 Dec 2015 14:10:32 +0000 (+0000) Subject: DWARF: describe properly Ada packed arrays X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2d5958875d2df15d6d04a3371dd6b54ec14a4e53;p=gcc.git DWARF: describe properly Ada packed arrays gcc/ada/ChangeLog: * gcc-interface/ada-tree.h (TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P, TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New macros. * gcc-interface/decl.c (add_parallel_type_for_packed_array): Rename to associate_original_type_to_packed_array. When -fgnat-encodings=minimal, set original packed array type as so instead of as a parallel type to the implementation type. In this case, also rename the implementation type to the name of the original array type. (gnat_to_gnu_entity): Update invocations to add_parallel_type_for_packed_array. Tag ARRAY_TYPE nodes for packed arrays with the TYPE_PACKED flag. When -fgnat-encodings=minimal: - strip ___XP suffixes in packed arrays' names; - set the debug type for padding records around packed arrays to the packed array; - do not attach ___XUP types as parallel types of constrained array types. * gcc-interface/misc.c (gnat_print_type): Update to handle orignal packed arrays. (gnat_get_debug_type): Update to reject packed arrays implementation types. (get_array_bit_stride): New. (gnat_get_array_descr_info): Add packed arrays handling. * gcc-interface/utils.c (maybe_pad_type): When -fgnat-encodings=minimal, set the name of the padding type to the one of the original packed type, if any. Fix TYPE_DECL peeling around the name of the input type. From-SVN: r231768 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 80c5a39d803..0ad84e2bb76 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2015-12-17 Pierre-Marie de Rodat + + * gcc-interface/ada-tree.h + (TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P, + TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New + macros. + * gcc-interface/decl.c (add_parallel_type_for_packed_array): + Rename to associate_original_type_to_packed_array. When + -fgnat-encodings=minimal, set original packed array type as so + instead of as a parallel type to the implementation type. In + this case, also rename the implementation type to the name of + the original array type. + (gnat_to_gnu_entity): Update invocations to + add_parallel_type_for_packed_array. Tag ARRAY_TYPE nodes for + packed arrays with the TYPE_PACKED flag. + When -fgnat-encodings=minimal: + - strip ___XP suffixes in packed arrays' names; + - set the debug type for padding records around packed arrays + to the packed array; + - do not attach ___XUP types as parallel types of constrained + array types. + * gcc-interface/misc.c (gnat_print_type): Update to handle + orignal packed arrays. + (gnat_get_debug_type): Update to reject packed arrays + implementation types. + (get_array_bit_stride): New. + (gnat_get_array_descr_info): Add packed arrays handling. + * gcc-interface/utils.c (maybe_pad_type): When + -fgnat-encodings=minimal, set the name of the padding type to + the one of the original packed type, if any. Fix TYPE_DECL + peeling around the name of the input type. + 2015-12-17 Pierre-Marie de Rodat * gcc-interface/misc.c (gnat_get_type_bias): New. diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 709fdc27061..830062791b9 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -187,6 +187,17 @@ do { \ alignment value the type ought to have. */ #define TYPE_MAX_ALIGN(NODE) (TYPE_PRECISION (RECORD_OR_UNION_CHECK (NODE))) +/* True for types that implement a packed array and for original packed array + types. */ +#define TYPE_IMPLEMENTS_PACKED_ARRAY_P(NODE) \ + ((TREE_CODE (NODE) == ARRAY_TYPE && TYPE_PACKED (NODE)) \ + || (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_PACKED_ARRAY_TYPE_P (NODE))) \ + +/* True for types that can hold a debug type. */ +#define TYPE_CAN_HAVE_DEBUG_TYPE_P(NODE) \ + (!TYPE_IMPLEMENTS_PACKED_ARRAY_P (NODE) \ + && TYPE_DEBUG_TYPE (NODE) != NULL_TREE) + /* For an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the template and the object. @@ -374,6 +385,21 @@ do { \ #define SET_TYPE_SCALE_FACTOR(NODE, X) \ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X) +/* For types with TYPE_CAN_HAVE_DEBUG_TYPE_P, this is the type to use in + debugging information. */ +#define TYPE_DEBUG_TYPE(NODE) \ + GET_TYPE_LANG_SPECIFIC2(NODE) +#define SET_TYPE_DEBUG_TYPE(NODE, X) \ + SET_TYPE_LANG_SPECIFIC2(NODE, X) + +/* For types with TYPE_IMPLEMENTS_PACKED_ARRAY_P, this is the original packed + array type. Note that this predicate is trou for original packed array + types, so these cannot have a debug type. */ +#define TYPE_ORIGINAL_PACKED_ARRAY(NODE) \ + GET_TYPE_LANG_SPECIFIC2(NODE) +#define SET_TYPE_ORIGINAL_PACKED_ARRAY(NODE, X) \ + SET_TYPE_LANG_SPECIFIC2(NODE, X) + /* Flags added to decl nodes. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 287898ffb94..7058ef0809f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -195,7 +195,7 @@ static tree get_rep_part (tree); static tree create_variant_part_from (tree, vec , tree, tree, vec ); static void copy_and_substitute_in_size (tree, tree, vec ); -static void add_parallel_type_for_packed_array (tree, Entity_Id); +static void associate_original_type_to_packed_array (tree, Entity_Id); static const char *get_entity_char (Entity_Id); /* The relevant constituents of a subprogram binding to a GCC builtin. Used @@ -1806,9 +1806,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (gnu_entity_name, gnu_type); - /* For a packed array, make the original array type a parallel type. */ + /* For a packed array, make the original array type a parallel/debug + type. */ if (debug_info_p && Is_Packed_Array_Impl_Type (gnat_entity)) - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + associate_original_type_to_packed_array (gnu_type, gnat_entity); discrete_type: @@ -1841,6 +1842,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) UI_To_gnu (RM_Size (gnat_entity), bitsizetype)); TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1; + /* Strip the ___XP suffix for standard DWARF. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + gnu_entity_name = TYPE_NAME (gnu_type); + /* Create a stripped-down declaration, mainly for debugging. */ create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p, gnat_entity); @@ -1885,8 +1890,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (debug_info_p) { - /* Make the original array type a parallel type. */ - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + /* Make the original array type a parallel/debug type. */ + associate_original_type_to_packed_array (gnu_type, gnat_entity); + + /* Since GNU_TYPE is a padding type around the packed array + implementation type, the padded type is its debug type. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); rest_of_record_type_compilation (gnu_type); } @@ -2241,6 +2251,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p; + /* Tag top-level ARRAY_TYPE nodes for packed arrays and their + implementation types as such so that the debug information back-end + can output the appropriate description for them. */ + TYPE_PACKED (tem) + = (Is_Packed (gnat_entity) + || Is_Packed_Array_Impl_Type (gnat_entity)); + if (Treat_As_Volatile (gnat_entity)) tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE); @@ -2603,6 +2620,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; } + /* Strip the ___XP suffix for standard DWARF. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && Is_Packed_Array_Impl_Type (gnat_entity)) + { + Entity_Id gnat_original_array_type + = Underlying_Type (Original_Array_Type (gnat_entity)); + + gnu_entity_name + = get_entity_name (gnat_original_array_type); + } + /* Attach the TYPE_STUB_DECL in case we have a parallel type. */ TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (gnu_entity_name, gnu_type); @@ -2677,17 +2705,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If this is a packed array type, make the original array type a - parallel type. Otherwise, do it for the base array type if it - isn't artificial to make sure it is kept in the debug info. */ + parallel/debug type. Otherwise, if such GNAT encodings are + required, do it for the base array type if it isn't artificial to + make sure it is kept in the debug info. */ if (debug_info_p) { if (Is_Packed_Array_Impl_Type (gnat_entity)) - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + associate_original_type_to_packed_array (gnu_type, + gnat_entity); else { tree gnu_base_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0); - if (!DECL_ARTIFICIAL (gnu_base_decl)) + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + && !DECL_ARTIFICIAL (gnu_base_decl)) add_parallel_type (gnu_type, TREE_TYPE (TREE_TYPE (gnu_base_decl))); } @@ -2698,6 +2729,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = (Is_Packed_Array_Impl_Type (gnat_entity) && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))); + /* Tag top-level ARRAY_TYPE nodes for packed arrays and their + implementation types as such so that the debug information back-end + can output the appropriate description for them. */ + TYPE_PACKED (gnu_type) + = (Is_Packed (gnat_entity) + || Is_Packed_Array_Impl_Type (gnat_entity)); + /* If the size is self-referential and the maximum size doesn't overflow, use it. */ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) @@ -2754,6 +2792,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) NULL_TREE, 0); this_made_decl = true; gnu_type = TREE_TYPE (gnu_decl); + save_gnu_tree (gnat_entity, NULL_TREE, false); gnu_inner = gnu_type; @@ -8832,12 +8871,14 @@ copy_and_substitute_in_size (tree new_type, tree old_type, TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type)); } -/* Add a parallel type to GNU_TYPE, the translation of GNAT_ENTITY, which is - the implementation type of a packed array type (Is_Packed_Array_Impl_Type). - The parallel type is the original array type if it has been translated. */ +/* Associate to GNU_TYPE, the translation of GNAT_ENTITY, which is + the implementation type of a packed array type (Is_Packed_Array_Impl_Type), + the original array type if it has been translated. This association is a + parallel type for GNAT encodings or a debug type for standard DWARF. Note + that for standard DWARF, we also want to get the original type name. */ static void -add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity) +associate_original_type_to_packed_array (tree gnu_type, Entity_Id gnat_entity) { Entity_Id gnat_original_array_type = Underlying_Type (Original_Array_Type (gnat_entity)); @@ -8851,7 +8892,18 @@ add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity) if (TYPE_IS_DUMMY_P (gnu_original_array_type)) return; - add_parallel_type (gnu_type, gnu_original_array_type); + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + { + tree original_name = TYPE_NAME (gnu_original_array_type); + + if (TREE_CODE (original_name) == TYPE_DECL) + original_name = DECL_NAME (original_name); + + SET_TYPE_ORIGINAL_PACKED_ARRAY (gnu_type, gnu_original_array_type); + TYPE_NAME (gnu_type) = original_name; + } + else + add_parallel_type (gnu_type, gnu_original_array_type); } /* Given a type T, a FIELD_DECL F, and a replacement value R, return a diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 269960f917d..adaea7f6465 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -528,9 +528,12 @@ gnat_print_type (FILE *file, tree node, int indent) break; } - if (TYPE_DEBUG_TYPE (node) != NULL_TREE) - print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), - indent + 4); + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node) != NULL_TREE) + print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4); + else if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (node) + && TYPE_ORIGINAL_PACKED_ARRAY (node) != NULL_TREE) + print_node_brief (file, "original packed array", + TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4); } /* Return the name to be printed for DECL. */ @@ -578,7 +581,18 @@ gnat_descriptive_type (const_tree type) static tree gnat_get_debug_type (const_tree type) { - return TYPE_DEBUG_TYPE (type); + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type)) + { + type = TYPE_DEBUG_TYPE (type); + /* ??? Kludge: the get_debug_type language hook is processed after the + array descriptor language hook, so if there is an array behind this + type, the latter is supposed to handle it. Still, we can get here + with a type we are not supposed to handle (when the DWARF back-end + processes the type of a variable), so keep this guard. */ + if (type != NULL_TREE && !TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)) + return const_cast (type); + } + return NULL_TREE; } /* Provide information in INFO for debugging output about the TYPE fixed-point @@ -732,17 +746,21 @@ gnat_type_max_size (const_tree gnu_type) return max_unitsize; } +static tree get_array_bit_stride (tree comp_type); + /* Provide information in INFO for debug output about the TYPE array type. Return whether TYPE is handled. */ static bool -gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) +gnat_get_array_descr_info (const_tree const_type, + struct array_descr_info *info) { bool convention_fortran_p; bool is_array = false; bool is_fat_ptr = false; + bool is_packed_array = false; - const tree type_ = const_cast (type); + tree type = const_cast (const_type); const_tree first_dimen = NULL_TREE; const_tree last_dimen = NULL_TREE; @@ -756,6 +774,20 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) tree thinptr_template_expr = NULL_TREE; tree thinptr_bound_field = NULL_TREE; + /* ??? Kludge: see gnat_get_debug_type. */ + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type) + && TYPE_DEBUG_TYPE (type) != NULL_TREE) + type = TYPE_DEBUG_TYPE (type); + + /* If we have an implementation type for a packed array, get the orignial + array type. */ + if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (type) + && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE) + { + is_packed_array = true; + type = TYPE_ORIGINAL_PACKED_ARRAY (type); + } + /* First pass: gather all information about this array except everything related to dimensions. */ @@ -772,10 +804,10 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL && TYPE_IS_FAT_POINTER_P (type)) { - const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_); + const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type); /* This will be our base object address. */ - const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF node. */ @@ -803,7 +835,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) /* This will be our base object address. Note that we assume that pointers to these will actually point to the array field (thin pointers are shifted). */ - const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); const tree placeholder_addr = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr); @@ -838,6 +870,8 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) /* Second pass: compute the remaining information: dimensions and corresponding bounds. */ + if (TYPE_PACKED (first_dimen)) + is_packed_array = true; /* If this array has fortran convention, it's arranged in column-major order, so our view here has reversed dimensions. */ convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen); @@ -937,13 +971,13 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->allocated = NULL_TREE; info->associated = NULL_TREE; - /* When arrays contain dynamically-sized elements, we usually wrap them in - padding types, or we create constrained types for them. Then, if such - types are stripped in the debugging information output, the debugger needs - a way to know the size that is reserved for each element. This is why we - emit a stride in such situations. */ if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) { + /* When arrays contain dynamically-sized elements, we usually wrap them + in padding types, or we create constrained types for them. Then, if + such types are stripped in the debugging information output, the + debugger needs a way to know the size that is reserved for each + element. This is why we emit a stride in such situations. */ tree source_element_type = info->element_type; while (1) @@ -962,11 +996,80 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->stride = TYPE_SIZE_UNIT (info->element_type); info->stride_in_bits = false; } + + /* We need to specify a bit stride when it does not correspond to the + natural size of the contained elements. ??? Note that we do not + support packed records and nested packed arrays. */ + else if (is_packed_array) + { + info->stride = get_array_bit_stride (info->element_type); + info->stride_in_bits = true; + } } return true; } +/* Given the component type COMP_TYPE of a packed array, return an expression + that computes the bit stride of this packed array. Return NULL_TREE when + unsuccessful. */ + +static tree +get_array_bit_stride (tree comp_type) +{ + struct array_descr_info info; + tree stride; + + /* Simple case: the array contains an integral type: return its RM size. */ + if (INTEGRAL_TYPE_P (comp_type)) + return TYPE_RM_SIZE (comp_type); + + /* Otherwise, see if this is an array we can analyze. */ + memset (&info, 0, sizeof (info)); + if (!gnat_get_array_descr_info (comp_type, &info) + || info.stride == NULL_TREE) + /* If it's not, give it up. */ + return NULL_TREE; + + /* Otherwise, the array stride is the inner array's stride multiplied by the + number of elements it contains. Note that if the inner array is not + packed, then the stride is "natural" and thus does not deserve an + attribute. */ + stride = info.stride; + if (!info.stride_in_bits) + { + stride = fold_convert (bitsizetype, stride); + stride = build_binary_op (MULT_EXPR, bitsizetype, + stride, build_int_cstu (bitsizetype, 8)); + } + + for (int i = 0; i < info.ndimensions; ++i) + { + tree count; + + if (info.dimen[i].lower_bound == NULL_TREE + || info.dimen[i].upper_bound == NULL_TREE) + return NULL_TREE; + + /* Put in count an expression that computes the length of this + dimension. */ + count = build_binary_op (MINUS_EXPR, sbitsizetype, + fold_convert (sbitsizetype, + info.dimen[i].upper_bound), + fold_convert (sbitsizetype, + info.dimen[i].lower_bound)), + count = build_binary_op (PLUS_EXPR, sbitsizetype, + count, build_int_cstu (sbitsizetype, 1)); + count = build_binary_op (MAX_EXPR, sbitsizetype, + count, + build_int_cstu (sbitsizetype, 0)); + count = fold_convert (bitsizetype, count); + stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count); + } + + return stride; +} + /* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound and HIGHVAL to the high bound, respectively. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 1816f3a9a26..be3565a503f 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1281,7 +1281,17 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) SET_TYPE_DEBUG_TYPE (record, type); - if (Present (gnat_entity)) + /* ??? Kludge: padding types around packed array implementation types will be + considered as root types in the array descriptor language hook (see + gnat_get_array_descr_info). Give them the original packed array type + name so that the one coming from sources appears in the debugging + information. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && TYPE_IMPLEMENTS_PACKED_ARRAY_P (type) + && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE) + TYPE_NAME (record) + = TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type)); + else if (Present (gnat_entity)) TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); TYPE_ALIGN (record) = align ? align : orig_align;