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.
......
...@@ -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