diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 28 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 4 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 53 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 42 |
4 files changed, 99 insertions, 28 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 5d93ea4..807da9d 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -33,21 +33,21 @@ union GTY((desc ("0"), }; /* Ada uses the lang_decl and lang_type fields to hold a tree. */ -struct GTY(()) lang_type { tree t; }; +struct GTY(()) lang_type { tree t1; tree t2; }; struct GTY(()) lang_decl { tree t; }; -/* Macros to get and set the tree in TYPE_LANG_SPECIFIC. */ +extern struct lang_type *get_lang_specific (tree node); + +/* Macros to get and set the trees in TYPE_LANG_SPECIFIC. */ #define GET_TYPE_LANG_SPECIFIC(NODE) \ - (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE) + (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t1 : NULL_TREE) -#define SET_TYPE_LANG_SPECIFIC(NODE, X) \ -do { \ - tree tmp = (X); \ - if (!TYPE_LANG_SPECIFIC (NODE)) \ - TYPE_LANG_SPECIFIC (NODE) \ - = ggc_alloc<struct lang_type> (); \ - TYPE_LANG_SPECIFIC (NODE)->t = tmp; \ -} while (0) +#define SET_TYPE_LANG_SPECIFIC(NODE, X) (get_lang_specific (NODE)->t1 = (X)) + +#define GET_TYPE_LANG_SPECIFIC2(NODE) \ + (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t2 : NULL_TREE) + +#define SET_TYPE_LANG_SPECIFIC2(NODE, X) (get_lang_specific (NODE)->t2 = (X)) /* Macros to get and set the tree in DECL_LANG_SPECIFIC. */ #define GET_DECL_LANG_SPECIFIC(NODE) \ @@ -351,6 +351,12 @@ do { \ #define SET_TYPE_ADA_SIZE(NODE, X) \ SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_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) /* Flags added to decl nodes. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 4db1193..385b720 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1846,6 +1846,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD"); + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); TYPE_PACKED (gnu_type) = 1; TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type); TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type); @@ -3277,6 +3279,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_name; + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_base_type); TYPE_PACKED (gnu_type) = TYPE_PACKED (gnu_base_type); TYPE_REVERSE_STORAGE_ORDER (gnu_type) = Reverse_Storage_Order (gnat_entity); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index ef0fe3f..e9df63c 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -524,6 +524,10 @@ gnat_print_type (FILE *file, tree node, int indent) default: break; } + + if (TYPE_DEBUG_TYPE (node) != NULL_TREE) + print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), + indent + 4); } /* Return the name to be printed for DECL. */ @@ -565,6 +569,15 @@ gnat_descriptive_type (const_tree type) return NULL_TREE; } +/* Return the type to used for debugging information instead of TYPE, if any. + NULL_TREE if TYPE is fine. */ + +static tree +gnat_get_debug_type (const_tree type) +{ + return TYPE_DEBUG_TYPE (type); +} + /* Return true if types T1 and T2 are identical for type hashing purposes. Called only after doing all language independent checks. At present, this function is only called when both types are FUNCTION_TYPE. */ @@ -697,6 +710,33 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->element_type = TREE_TYPE (last_dimen); + /* 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) + { + tree source_element_type = info->element_type; + + while (1) + { + if (TYPE_DEBUG_TYPE (source_element_type) != NULL_TREE) + source_element_type = TYPE_DEBUG_TYPE (source_element_type); + else if (TYPE_IS_PADDING_P (source_element_type)) + source_element_type + = TREE_TYPE (TYPE_FIELDS (source_element_type)); + else + break; + } + + if (TREE_CODE (TYPE_SIZE_UNIT (source_element_type)) != INTEGER_CST) + { + info->stride = TYPE_SIZE_UNIT (info->element_type); + info->stride_in_bits = false; + } + } + return true; } @@ -947,6 +987,17 @@ gnat_init_ts (void) MARK_TS_TYPED (EXIT_STMT); } +/* Return the lang specific structure attached to NODE. Allocate it (cleared) + if needed. */ + +struct lang_type * +get_lang_specific (tree node) +{ + if (!TYPE_LANG_SPECIFIC (node)) + TYPE_LANG_SPECIFIC (node) = ggc_cleared_alloc<struct lang_type> (); + return TYPE_LANG_SPECIFIC (node); +} + /* Definitions for our language-specific hooks. */ #undef LANG_HOOKS_NAME @@ -999,6 +1050,8 @@ gnat_init_ts (void) #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds #undef LANG_HOOKS_DESCRIPTIVE_TYPE #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type +#undef LANG_HOOKS_GET_DEBUG_TYPE +#define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type #undef LANG_HOOKS_ATTRIBUTE_TABLE #define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table #undef LANG_HOOKS_BUILTIN_FUNCTION diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 830a0b8..1816f3a 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1278,6 +1278,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, type and name. */ record = make_node (RECORD_TYPE); TYPE_PADDING_P (record) = 1; + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (record, type); if (Present (gnat_entity)) TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); @@ -1348,10 +1350,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, /* Unless debugging information isn't being written for the input type, write a record that shows what we are a subtype of and also make a - variable that indicates our size, if still variable. Don't do this if - asked to output as few encodings as possible. */ - if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL - && TREE_CODE (orig_size) != INTEGER_CST + variable that indicates our size, if still variable. */ + if (TREE_CODE (orig_size) != INTEGER_CST && TYPE_NAME (record) && TYPE_NAME (type) && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL @@ -1367,6 +1367,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, && TREE_CODE (size) != INTEGER_CST && (definition || global_bindings_p ())) { + /* Whether or not gnat_entity comes from source, this XVZ variable is + is a compilation artifact. */ size_unit = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, size_unit, true, global_bindings_p (), @@ -1375,19 +1377,25 @@ maybe_pad_type (tree type, tree size, unsigned int align, TYPE_SIZE_UNIT (record) = size_unit; } - tree marker = make_node (RECORD_TYPE); - tree orig_name = TYPE_IDENTIFIER (type); - - TYPE_NAME (marker) = concat_name (name, "XVS"); - finish_record_type (marker, - create_field_decl (orig_name, - build_reference_type (type), - marker, NULL_TREE, NULL_TREE, - 0, 0), - 0, true); - TYPE_SIZE_UNIT (marker) = size_unit; - - add_parallel_type (record, marker); + /* There is no need to show what we are a subtype of when outputting as + few encodings as possible: regular debugging infomation makes this + redundant. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + { + tree marker = make_node (RECORD_TYPE); + tree orig_name = TYPE_IDENTIFIER (type); + + TYPE_NAME (marker) = concat_name (name, "XVS"); + finish_record_type (marker, + create_field_decl (orig_name, + build_reference_type (type), + marker, NULL_TREE, NULL_TREE, + 0, 0), + 0, true); + TYPE_SIZE_UNIT (marker) = size_unit; + + add_parallel_type (record, marker); + } } rest_of_record_type_compilation (record); |