Commit 032d1b71 by Eric Botcazou Committed by Eric Botcazou

sem_util.adb (Set_Debug_Info_Needed): For an E_Class_Wide_Subtype, also set the…

sem_util.adb (Set_Debug_Info_Needed): For an E_Class_Wide_Subtype, also set the flag on the Equivalent_Type.

	* sem_util.adb (Set_Debug_Info_Needed): For an E_Class_Wide_Subtype,
	also set the flag on the Equivalent_Type.
	* gcc-interface/utils.c (finish_record_type): Replace DO_NOT_FINALIZE
	parameter with DEBUG_INFO_P.  Rename FIELDLIST into FIELD_LIST.
	(rest_of_record_type_compilation): Rename FIELDLIST into FIELD_LIST.
	(build_vms_descriptor32): Adjust call to finish_record_type.
	(build_vms_descriptor): Likewise.
	(build_unc_object_type): Likewise.
	* decl.c (gnat_to_gnu_entity): Adjust calls to finish_record_type and
	components_to_record.
	(make_packable_type): Adjust call to finish_record_type.
	(maybe_pad_type): Likewise.  Tweak condition.
	(components_to_record): Likewise.  Replace DO_NOT_FINALIZE parameter
	with MAYBE_UNUSED.  Adjust recursive call.
	(create_variant_part_from): Adjust call to finish_record_type.  Do not
	call rest_of_record_type_compilation on the new record types.
	* trans.c (gigi): Adjust call to finish_record_type.
	* gigi.h (finish_record_type): Adjust prototype and comment.
	(rest_of_record_type_compilation): Adjust comment.

From-SVN: r154515
parent cbae498b
2009-11-24 Eric Botcazou <ebotcazou@adacore.com> 2009-11-24 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.adb (Set_Debug_Info_Needed): For an E_Class_Wide_Subtype,
also set the flag on the Equivalent_Type.
* gcc-interface/utils.c (finish_record_type): Replace DO_NOT_FINALIZE
parameter with DEBUG_INFO_P. Rename FIELDLIST into FIELD_LIST.
(rest_of_record_type_compilation): Rename FIELDLIST into FIELD_LIST.
(build_vms_descriptor32): Adjust call to finish_record_type.
(build_vms_descriptor): Likewise.
(build_unc_object_type): Likewise.
* decl.c (gnat_to_gnu_entity): Adjust calls to finish_record_type and
components_to_record.
(make_packable_type): Adjust call to finish_record_type.
(maybe_pad_type): Likewise. Tweak condition.
(components_to_record): Likewise. Replace DO_NOT_FINALIZE parameter
with MAYBE_UNUSED. Adjust recursive call.
(create_variant_part_from): Adjust call to finish_record_type. Do not
call rest_of_record_type_compilation on the new record types.
* trans.c (gigi): Adjust call to finish_record_type.
* gigi.h (finish_record_type): Adjust prototype and comment.
(rest_of_record_type_compilation): Adjust comment.
2009-11-24 Eric Botcazou <ebotcazou@adacore.com>
* exp_util.adb (Make_CW_Equivalent_Type): Do not mark the type as * exp_util.adb (Make_CW_Equivalent_Type): Do not mark the type as
frozen for targets that do not require front-end layout. frozen for targets that do not require front-end layout.
(New_Class_Wide_Subtype): Always reset the freezing status to False. (New_Class_Wide_Subtype): Always reset the freezing status to False.
......
...@@ -1630,21 +1630,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1630,21 +1630,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field = create_field_decl (get_identifier ("OBJECT"),
gnu_field_type, gnu_type, 1, 0, 0, 0); gnu_field_type, gnu_type, 1, 0, 0, 0);
/* Do not finalize it until after the parallel type is added. */ /* Do not emit debug info until after the parallel type is added. */
finish_record_type (gnu_type, gnu_field, 0, true); finish_record_type (gnu_type, gnu_field, 0, false);
TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
if (debug_info_p)
{
/* Make the original array type a parallel type. */ /* Make the original array type a parallel type. */
if (debug_info_p if (present_gnu_tree (Original_Array_Type (gnat_entity)))
&& present_gnu_tree (Original_Array_Type (gnat_entity)))
add_parallel_type (TYPE_STUB_DECL (gnu_type), add_parallel_type (TYPE_STUB_DECL (gnu_type),
gnat_to_gnu_type gnat_to_gnu_type
(Original_Array_Type (gnat_entity))); (Original_Array_Type (gnat_entity)));
rest_of_record_type_compilation (gnu_type); rest_of_record_type_compilation (gnu_type);
} }
}
/* If the type we are dealing with has got a smaller alignment than the /* If the type we are dealing with has got a smaller alignment than the
natural one, we need to wrap it up in a record type and under-align natural one, we need to wrap it up in a record type and under-align
...@@ -1678,7 +1680,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1678,7 +1680,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field = create_field_decl (get_identifier ("OBJECT"),
gnu_field_type, gnu_type, 1, 0, 0, 0); gnu_field_type, gnu_type, 1, 0, 0, 0);
finish_record_type (gnu_type, gnu_field, 0, false); finish_record_type (gnu_type, gnu_field, 0, debug_info_p);
TYPE_PADDING_P (gnu_type) = 1; TYPE_PADDING_P (gnu_type) = 1;
relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
...@@ -1824,9 +1826,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1824,9 +1826,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Make sure we can put this into a register. */ /* Make sure we can put this into a register. */
TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
/* Do not finalize this record type since the types of its fields /* Do not emit debug info for this record type since the types of its
are still incomplete at this point. */ fields are still incomplete at this point. */
finish_record_type (gnu_fat_type, tem, 0, true); finish_record_type (gnu_fat_type, tem, 0, false);
TYPE_FAT_POINTER_P (gnu_fat_type) = 1; TYPE_FAT_POINTER_P (gnu_fat_type) = 1;
/* Build a reference to the template from a PLACEHOLDER_EXPR that /* Build a reference to the template from a PLACEHOLDER_EXPR that
...@@ -1933,7 +1935,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1933,7 +1935,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= chainon (gnu_template_fields, gnu_temp_fields[index]); = chainon (gnu_template_fields, gnu_temp_fields[index]);
/* Install all the fields into the template. */ /* Install all the fields into the template. */
finish_record_type (gnu_template_type, gnu_template_fields, 0, false); finish_record_type (gnu_template_type, gnu_template_fields, 0,
debug_info_p);
TYPE_READONLY (gnu_template_type) = 1; TYPE_READONLY (gnu_template_type) = 1;
/* Now make the array of arrays and update the pointer to the array /* Now make the array of arrays and update the pointer to the array
...@@ -2393,7 +2396,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2393,7 +2396,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field_list = gnu_field; gnu_field_list = gnu_field;
} }
finish_record_type (gnu_bound_rec, gnu_field_list, 0, false); finish_record_type (gnu_bound_rec, gnu_field_list, 0, true);
add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec); add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
} }
...@@ -2867,8 +2870,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2867,8 +2870,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Add the fields into the record type and finish it up. */ /* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition), components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, NULL, gnu_field_list, packed, definition, NULL,
false, all_rep, false, is_unchecked_union, false, all_rep, is_unchecked_union,
debug_info_p); debug_info_p, false);
/* If it is a tagged record force the type to BLKmode to insure that /* If it is a tagged record force the type to BLKmode to insure that
these objects will always be put in memory. Likewise for limited these objects will always be put in memory. Likewise for limited
...@@ -3188,9 +3191,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3188,9 +3191,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !present_gnu_tree (Etype (gnat_field))) && !present_gnu_tree (Etype (gnat_field)))
gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0); gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
/* Do not finalize it since we're going to modify it below. */ /* Do not emit debug info for the type yet since we're going to
modify it below. */
gnu_field_list = nreverse (gnu_field_list); gnu_field_list = nreverse (gnu_field_list);
finish_record_type (gnu_type, gnu_field_list, 2, true); finish_record_type (gnu_type, gnu_field_list, 2, false);
/* See the E_Record_Type case for the rationale. */ /* See the E_Record_Type case for the rationale. */
if (Is_Tagged_Type (gnat_entity) if (Is_Tagged_Type (gnat_entity)
...@@ -3225,7 +3229,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3225,7 +3229,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_subtype_marker, gnu_subtype_marker,
0, NULL_TREE, 0, NULL_TREE,
NULL_TREE, 0), NULL_TREE, 0),
0, false); 0, true);
add_parallel_type (TYPE_STUB_DECL (gnu_type), add_parallel_type (TYPE_STUB_DECL (gnu_type),
gnu_subtype_marker); gnu_subtype_marker);
...@@ -3459,9 +3463,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3459,9 +3463,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
TYPE_FAT_POINTER_P (gnu_type) = 1; TYPE_FAT_POINTER_P (gnu_type) = 1;
/* Do not finalize this record type since the types of /* Do not emit debug info for this record type since the types
its fields are incomplete. */ of its fields are incomplete. */
finish_record_type (gnu_type, fields, 0, true); finish_record_type (gnu_type, fields, 0, false);
TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE); TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE);
TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old)) TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old))
...@@ -4074,7 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4074,7 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
stubbed since structures are incomplete for the back-end. */ stubbed since structures are incomplete for the back-end. */
if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed) if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed)
finish_record_type (gnu_return_type, nreverse (gnu_field_list), finish_record_type (gnu_return_type, nreverse (gnu_field_list),
0, false); 0, debug_info_p);
/* If we have a CICO list but it has only one entry, we convert /* If we have a CICO list but it has only one entry, we convert
this function into a function that simply returns that one this function into a function that simply returns that one
...@@ -6041,7 +6045,7 @@ make_packable_type (tree type, bool in_record) ...@@ -6041,7 +6045,7 @@ make_packable_type (tree type, bool in_record)
field_list = new_field; field_list = new_field;
} }
finish_record_type (new_type, nreverse (field_list), 2, true); finish_record_type (new_type, nreverse (field_list), 2, false);
relate_alias_sets (new_type, type, ALIAS_SET_COPY); relate_alias_sets (new_type, type, ALIAS_SET_COPY);
/* If this is a padding record, we never want to make the size smaller /* If this is a padding record, we never want to make the size smaller
...@@ -6198,8 +6202,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -6198,8 +6202,8 @@ maybe_pad_type (tree type, tree size, unsigned int align,
orig_size, bitsize_zero_node, 1); orig_size, bitsize_zero_node, 1);
DECL_INTERNAL_P (field) = 1; DECL_INTERNAL_P (field) = 1;
/* Do not finalize it until after the auxiliary record is built. */ /* Do not emit debug info until after the auxiliary record is built. */
finish_record_type (record, field, 1, true); finish_record_type (record, field, 1, false);
/* Set the same size for its RM size if requested; otherwise reuse /* Set the same size for its RM size if requested; otherwise reuse
the RM size of the original type. */ the RM size of the original type. */
...@@ -6208,9 +6212,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -6208,9 +6212,9 @@ maybe_pad_type (tree type, tree size, unsigned int align,
/* Unless debugging information isn't being written for the input type, /* 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 write a record that shows what we are a subtype of and also make a
variable that indicates our size, if still variable. */ variable that indicates our size, if still variable. */
if (TYPE_NAME (record) if (TREE_CODE (orig_size) != INTEGER_CST
&& AGGREGATE_TYPE_P (type) && TYPE_NAME (record)
&& TREE_CODE (orig_size) != INTEGER_CST && TYPE_NAME (type)
&& !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
&& DECL_IGNORED_P (TYPE_NAME (type)))) && DECL_IGNORED_P (TYPE_NAME (type))))
{ {
...@@ -6230,7 +6234,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -6230,7 +6234,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
build_reference_type (type), build_reference_type (type),
marker, 0, NULL_TREE, NULL_TREE, marker, 0, NULL_TREE, NULL_TREE,
0), 0),
0, false); 0, true);
add_parallel_type (TYPE_STUB_DECL (record), marker); add_parallel_type (TYPE_STUB_DECL (record), marker);
...@@ -6720,35 +6724,34 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) ...@@ -6720,35 +6724,34 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
with Component_Alignment of Storage_Unit, -2 if this is for a record with Component_Alignment of Storage_Unit, -2 if this is for a record
with a specified alignment. with a specified alignment.
DEFINITION is true if we are defining this record. DEFINITION is true if we are defining this record type.
P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field 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 with a rep clause is to be added; in this case, that is all that should
be done with such fields. be done with such fields.
CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before CANCEL_ALIGNMENT is true if the alignment should be zeroed before laying
laying out the record. This means the alignment only serves to force out the record. This means the alignment only serves to force fields to
fields to be bitfields, but not require the record to be that aligned. be bitfields, but not to require the record to be that aligned. This is
This is used for variants. used for variants.
ALL_REP, if true, means a rep clause was found for all the fields. This ALL_REP is true if a rep clause is present for all the fields.
simplifies the logic since we know we're not in the mixed case.
DO_NOT_FINALIZE, if true, means that the record type is expected to be UNCHECKED_UNION is true if we are building this type for a record with a
modified afterwards so it will not be finalized here. Pragma Unchecked_Union.
UNCHECKED_UNION, if true, means that we are building a type for a record DEBUG_INFO_P is true if we need to write debug information about the type.
with a Pragma Unchecked_Union.
MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
mean that its contents may be unused as well, but only the container. */
DEBUG_INFO_P, if true, means that we need to write debug information for
types that we may create in the process. */
static void static void
components_to_record (tree gnu_record_type, Node_Id gnat_component_list, components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition, tree gnu_field_list, int packed, bool definition,
tree *p_gnu_rep_list, bool cancel_alignment, tree *p_gnu_rep_list, bool cancel_alignment,
bool all_rep, bool do_not_finalize, bool all_rep, bool unchecked_union, bool debug_info_p,
bool unchecked_union, bool debug_info_p) bool maybe_unused)
{ {
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
bool layout_with_rep = false; bool layout_with_rep = false;
...@@ -6878,12 +6881,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6878,12 +6881,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
= TYPE_SIZE_UNIT (gnu_record_type); = TYPE_SIZE_UNIT (gnu_record_type);
} }
/* Add the fields into the record type for the variant. Note that we /* Add the fields into the record type for the variant. Note that
defer finalizing it until after we are sure to really use it. */ we aren't sure to really use it at this point, see below. */
components_to_record (gnu_variant_type, Component_List (variant), components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition, NULL_TREE, packed, definition,
&gnu_our_rep_list, !all_rep_and_size, all_rep, &gnu_our_rep_list, !all_rep_and_size, all_rep,
true, unchecked_union, debug_info_p); unchecked_union, debug_info_p, true);
gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
...@@ -6942,7 +6945,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6942,7 +6945,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
} }
finish_record_type (gnu_union_type, nreverse (gnu_variant_list), finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
all_rep_and_size ? 1 : 0, false); all_rep_and_size ? 1 : 0, debug_info_p);
/* If GNU_UNION_TYPE is our record type, it means we must have an /* If GNU_UNION_TYPE is our record type, it means we must have an
Unchecked_Union with no fields. Verify that and, if so, just Unchecked_Union with no fields. Verify that and, if so, just
...@@ -7034,7 +7037,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -7034,7 +7037,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
if (gnu_field_list) if (gnu_field_list)
{ {
finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, false); finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, debug_info_p);
gnu_field gnu_field
= create_field_decl (get_identifier ("REP"), gnu_rep_type, = create_field_decl (get_identifier ("REP"), gnu_rep_type,
gnu_record_type, 0, NULL_TREE, NULL_TREE, 1); gnu_record_type, 0, NULL_TREE, NULL_TREE, 1);
...@@ -7052,7 +7055,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -7052,7 +7055,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
TYPE_ALIGN (gnu_record_type) = 0; TYPE_ALIGN (gnu_record_type) = 0;
finish_record_type (gnu_record_type, nreverse (gnu_field_list), finish_record_type (gnu_record_type, nreverse (gnu_field_list),
layout_with_rep ? 1 : 0, do_not_finalize); layout_with_rep ? 1 : 0, debug_info_p && !maybe_unused);
} }
/* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
...@@ -8141,12 +8144,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list, ...@@ -8141,12 +8144,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list,
field_list = new_variant_subpart; field_list = new_variant_subpart;
} }
/* Finish up the new variant and create the field. */ /* Finish up the new variant and create the field. No need for debug
finish_record_type (new_variant, nreverse (field_list), 2, true); info thanks to the XVS type. */
finish_record_type (new_variant, nreverse (field_list), 2, false);
compute_record_mode (new_variant); compute_record_mode (new_variant);
rest_of_record_type_compilation (new_variant);
/* No need for debug info thanks to the XVS type. */
create_type_decl (TYPE_NAME (new_variant), new_variant, NULL, create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
true, false, Empty); true, false, Empty);
...@@ -8160,12 +8161,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list, ...@@ -8160,12 +8161,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list,
union_field_list = new_field; union_field_list = new_field;
} }
/* Finish up the union type and create the variant part. */ /* Finish up the union type and create the variant part. No need for debug
finish_record_type (new_union_type, union_field_list, 2, true); info thanks to the XVS type. */
finish_record_type (new_union_type, union_field_list, 2, false);
compute_record_mode (new_union_type); compute_record_mode (new_union_type);
rest_of_record_type_compilation (new_union_type);
/* No need for debug info thanks to the XVS type. */
create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL, create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
true, false, Empty); true, false, Empty);
......
...@@ -522,22 +522,21 @@ extern tree make_dummy_type (Entity_Id gnat_type); ...@@ -522,22 +522,21 @@ extern tree make_dummy_type (Entity_Id gnat_type);
/* Record TYPE as a builtin type for Ada. NAME is the name of the type. */ /* Record TYPE as a builtin type for Ada. NAME is the name of the type. */
extern void record_builtin_type (const char *name, tree type); extern void record_builtin_type (const char *name, tree type);
/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST, /* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
finish constructing the record or union type. If REP_LEVEL is zero, this finish constructing the record or union type. If REP_LEVEL is zero, this
record has no representation clause and so will be entirely laid out here. record has no representation clause and so will be entirely laid out here.
If REP_LEVEL is one, this record has a representation clause and has been If REP_LEVEL is one, this record has a representation clause and has been
laid out already; only set the sizes and alignment. If REP_LEVEL is two, laid out already; only set the sizes and alignment. If REP_LEVEL is two,
this record is derived from a parent record and thus inherits its layout; this record is derived from a parent record and thus inherits its layout;
only make a pass on the fields to finalize them. If DO_NOT_FINALIZE is only make a pass on the fields to finalize them. DEBUG_INFO_P is true if
true, the record type is expected to be modified afterwards so it will we need to write debug information about this type. */
not be sent to the back-end for finalization. */ extern void finish_record_type (tree record_type, tree field_list,
extern void finish_record_type (tree record_type, tree fieldlist, int rep_level, bool debug_info_p);
int rep_level, bool do_not_finalize);
/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information
/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all associated with it. It need not be invoked directly in most cases since
the debug information associated with it. It need not be invoked finish_record_type takes care of doing so, but this can be necessary if
directly in most cases since finish_record_type takes care of doing a parallel type is to be attached to the record type. */
so, unless explicitly requested not to through DO_NOT_FINALIZE. */
extern void rest_of_record_type_compilation (tree record_type); extern void rest_of_record_type_compilation (tree record_type);
/* Append PARALLEL_TYPE on the chain of parallel types for decl. */ /* Append PARALLEL_TYPE on the chain of parallel types for decl. */
......
...@@ -562,7 +562,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, ...@@ -562,7 +562,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
null_list = tree_cons (field, null_node, null_list); null_list = tree_cons (field, null_node, null_list);
} }
finish_record_type (fdesc_type_node, nreverse (field_list), 0, true); finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
record_builtin_type ("descriptor", fdesc_type_node); record_builtin_type ("descriptor", fdesc_type_node);
null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list); null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
} }
......
...@@ -560,19 +560,18 @@ record_builtin_type (const char *name, tree type) ...@@ -560,19 +560,18 @@ record_builtin_type (const char *name, tree type)
debug_hooks->type_decl (type_decl, false); debug_hooks->type_decl (type_decl, false);
} }
/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST, /* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
finish constructing the record or union type. If REP_LEVEL is zero, this finish constructing the record or union type. If REP_LEVEL is zero, this
record has no representation clause and so will be entirely laid out here. record has no representation clause and so will be entirely laid out here.
If REP_LEVEL is one, this record has a representation clause and has been If REP_LEVEL is one, this record has a representation clause and has been
laid out already; only set the sizes and alignment. If REP_LEVEL is two, laid out already; only set the sizes and alignment. If REP_LEVEL is two,
this record is derived from a parent record and thus inherits its layout; this record is derived from a parent record and thus inherits its layout;
only make a pass on the fields to finalize them. If DO_NOT_FINALIZE is only make a pass on the fields to finalize them. DEBUG_INFO_P is true if
true, the record type is expected to be modified afterwards so it will we need to write debug information about this type. */
not be sent to the back-end for finalization. */
void void
finish_record_type (tree record_type, tree fieldlist, int rep_level, finish_record_type (tree record_type, tree field_list, int rep_level,
bool do_not_finalize) bool debug_info_p)
{ {
enum tree_code code = TREE_CODE (record_type); enum tree_code code = TREE_CODE (record_type);
tree name = TYPE_NAME (record_type); tree name = TYPE_NAME (record_type);
...@@ -583,7 +582,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, ...@@ -583,7 +582,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
bool had_align = TYPE_ALIGN (record_type) != 0; bool had_align = TYPE_ALIGN (record_type) != 0;
tree field; tree field;
TYPE_FIELDS (record_type) = fieldlist; TYPE_FIELDS (record_type) = field_list;
/* Always attach the TYPE_STUB_DECL for a record type. It is required to /* Always attach the TYPE_STUB_DECL for a record type. It is required to
generate debug info and have a parallel type. */ generate debug info and have a parallel type. */
...@@ -627,9 +626,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, ...@@ -627,9 +626,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
handled yet, and adjust DECL_NONADDRESSABLE_P accordingly. */ handled yet, and adjust DECL_NONADDRESSABLE_P accordingly. */
if (code == QUAL_UNION_TYPE) if (code == QUAL_UNION_TYPE)
fieldlist = nreverse (fieldlist); field_list = nreverse (field_list);
for (field = fieldlist; field; field = TREE_CHAIN (field)) for (field = field_list; field; field = TREE_CHAIN (field))
{ {
tree type = TREE_TYPE (field); tree type = TREE_TYPE (field);
tree pos = bit_position (field); tree pos = bit_position (field);
...@@ -733,7 +732,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, ...@@ -733,7 +732,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
} }
if (code == QUAL_UNION_TYPE) if (code == QUAL_UNION_TYPE)
nreverse (fieldlist); nreverse (field_list);
if (rep_level < 2) if (rep_level < 2)
{ {
...@@ -764,24 +763,24 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, ...@@ -764,24 +763,24 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
} }
} }
if (!do_not_finalize) if (debug_info_p)
rest_of_record_type_compilation (record_type); rest_of_record_type_compilation (record_type);
} }
/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all /* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information
the debug information associated with it. It need not be invoked associated with it. It need not be invoked directly in most cases since
directly in most cases since finish_record_type takes care of doing finish_record_type takes care of doing so, but this can be necessary if
so, unless explicitly requested not to through DO_NOT_FINALIZE. */ a parallel type is to be attached to the record type. */
void void
rest_of_record_type_compilation (tree record_type) rest_of_record_type_compilation (tree record_type)
{ {
tree fieldlist = TYPE_FIELDS (record_type); tree field_list = TYPE_FIELDS (record_type);
tree field; tree field;
enum tree_code code = TREE_CODE (record_type); enum tree_code code = TREE_CODE (record_type);
bool var_size = false; bool var_size = false;
for (field = fieldlist; field; field = TREE_CHAIN (field)) for (field = field_list; field; field = TREE_CHAIN (field))
{ {
/* We need to make an XVE/XVU record if any field has variable size, /* We need to make an XVE/XVU record if any field has variable size,
whether or not the record does. For example, if we have a union, whether or not the record does. For example, if we have a union,
...@@ -2801,7 +2800,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2801,7 +2800,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
} }
TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC"); TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
finish_record_type (record_type, field_list, 0, true); finish_record_type (record_type, field_list, 0, false);
return record_type; return record_type;
} }
...@@ -3115,7 +3114,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -3115,7 +3114,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
} }
TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64"); TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
finish_record_type (record64_type, field_list64, 0, true); finish_record_type (record64_type, field_list64, 0, false);
return record64_type; return record64_type;
} }
...@@ -3527,7 +3526,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name) ...@@ -3527,7 +3526,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
finish_record_type (type, finish_record_type (type,
chainon (chainon (NULL_TREE, template_field), chainon (chainon (NULL_TREE, template_field),
array_field), array_field),
0, false); 0, true);
return type; return type;
} }
......
...@@ -10428,6 +10428,10 @@ package body Sem_Util is ...@@ -10428,6 +10428,10 @@ package body Sem_Util is
end loop; end loop;
end; end;
if Ekind (T) = E_Class_Wide_Subtype then
Set_Debug_Info_Needed_If_Not_Set (Equivalent_Type (T));
end if;
elsif Is_Array_Type (T) then elsif Is_Array_Type (T) then
Set_Debug_Info_Needed_If_Not_Set (Component_Type (T)); Set_Debug_Info_Needed_If_Not_Set (Component_Type (T));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment