OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (substitution_list): Rename to build_subst_list, remove unused parameter and simplify.

Browse Source 
* gcc-interface/decl.c (substitution_list): Rename to build_subst_list,
	remove unused parameter and simplify.
	(gnat_to_gnu_entity) <E_Record_Type>: Do not set TYPE_FIELDS.  Factor
	common predicate.  Rewrite loop for clarity.  Use GNU_TYPE directly
	as context for all discriminants.  Fix formatting nits.
	<E_Record_Subtype>: Add cosmetic 'break'.  Test Has_Discriminants
	before Discriminant_Constraint.  Adjust for above renaming.  Do not
	set GNU_TYPE more than once.
	(elaborate_entity): Test Has_Discriminants on the entity and use
	Implementation_Base_Type.
	(components_to_record): Rename component_list to gnat_component_list.
	Retrieve the _Parent field from the list.  Fix nits in comments.
	Clarify logic in loop.  Pass correct arguments to create_field_decl.

From-SVN: r148121
This commit is contained in:
Eric Botcazou 2009-06-03 10:26:20 +00:00 committed by Eric Botcazou
parent 2f2c62a01c
commit 8cd281486b
2 changed files with 196 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2009-06-03 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (substitution_list): Rename to build_subst_list,
remove unused parameter and simplify.
(gnat_to_gnu_entity) <E_Record_Type>: Do not set TYPE_FIELDS. Factor
common predicate. Rewrite loop for clarity. Use GNU_TYPE directly
as context for all discriminants. Fix formatting nits.
<E_Record_Subtype>: Add cosmetic 'break'. Test Has_Discriminants
before Discriminant_Constraint. Adjust for above renaming. Do not
set GNU_TYPE more than once.
(elaborate_entity): Test Has_Discriminants on the entity and use
Implementation_Base_Type.
(components_to_record): Rename component_list to gnat_component_list.
Retrieve the _Parent field from the list. Fix nits in comments.
Clarify logic in loop. Pass correct arguments to create_field_decl.
2009-06-02 Eric Botcazou <ebotcazou@adacore.com> 2009-06-02 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/Make-lang.in: Fix formatting. * gcc-interface/Make-lang.in: Fix formatting.

302
gcc/ada/gcc-interface/decl.c
View File

@ -121,7 +121,7 @@ enum alias_set_op
static void relate_alias_sets (tree, tree, enum alias_set_op); static void relate_alias_sets (tree, tree, enum alias_set_op);
static tree substitution_list (Entity_Id, Entity_Id, tree, bool); static tree build_subst_list (Entity_Id, Entity_Id, bool);
static bool allocatable_size_p (tree, bool); static bool allocatable_size_p (tree, bool);
static void prepend_one_attribute_to (struct attrib **, static void prepend_one_attribute_to (struct attrib **,
enum attr_type, tree, tree, Node_Id); enum attr_type, tree, tree, Node_Id);
@ -1820,7 +1820,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE); gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
if (!definition) if (!definition)
defer_incomplete_level++, this_deferred = true; {
defer_incomplete_level++;
this_deferred = true;
}
/* Build the fat pointer type. Use a "void *" object instead of /* Build the fat pointer type. Use a "void *" object instead of
a pointer to the array type since we don't have the array type a pointer to the array type since we don't have the array type
@ -2743,16 +2746,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool is_extension bool is_extension
= (Is_Tagged_Type (gnat_entity) = (Is_Tagged_Type (gnat_entity)
&& Nkind (record_definition) == N_Derived_Type_Definition); && Nkind (record_definition) == N_Derived_Type_Definition);
bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
/* See if all fields have a rep clause. Stop when we find one /* See if all fields have a rep clause. Stop when we find one
that doesn't. */ that doesn't. */
if (all_rep)
for (gnat_field = First_Entity (gnat_entity); for (gnat_field = First_Entity (gnat_entity);
Present (gnat_field) && all_rep; Present (gnat_field);
gnat_field = Next_Entity (gnat_field)) gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component if ((Ekind (gnat_field) == E_Component
|| Ekind (gnat_field) == E_Discriminant) || Ekind (gnat_field) == E_Discriminant)
&& No (Component_Clause (gnat_field))) && No (Component_Clause (gnat_field)))
{
all_rep = false; all_rep = false;
break;
}
/* If this is a record extension, go a level further to find the /* If this is a record extension, go a level further to find the
record definition. Also, verify we have a Parent_Subtype. */ record definition. Also, verify we have a Parent_Subtype. */
@ -2773,7 +2781,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_PACKED (gnu_type) = (packed != 0) || has_rep; TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
if (!definition) if (!definition)
defer_incomplete_level++, this_deferred = true; {
defer_incomplete_level++;
this_deferred = true;
}
/* If both a size and rep clause was specified, put the size in /* If both a size and rep clause was specified, put the size in
the record type now so that it can get the proper mode. */ the record type now so that it can get the proper mode. */
@ -2908,7 +2919,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
proper type... */ proper type... */
TREE_TYPE (gnu_get_parent) = gnu_parent; TREE_TYPE (gnu_get_parent) = gnu_parent;
/* ...and reference the _parent field of this record. */ /* ...and reference the _Parent field of this record. */
gnu_field_list gnu_field_list
= create_field_decl (get_identifier = create_field_decl (get_identifier
(Get_Name_String (Name_uParent)), (Get_Name_String (Name_uParent)),
@ -2926,9 +2937,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Present (gnat_field); Present (gnat_field);
gnat_field = Next_Stored_Discriminant (gnat_field)) gnat_field = Next_Stored_Discriminant (gnat_field))
{ {
/* If this is a record extension and this discriminant /* If this is a record extension and this discriminant is the
is the renaming of another discriminant, we've already renaming of another discriminant, we've handled it above. */
handled the discriminant above. */
if (Present (Parent_Subtype (gnat_entity)) if (Present (Parent_Subtype (gnat_entity))
&& Present (Corresponding_Discriminant (gnat_field))) && Present (Corresponding_Discriminant (gnat_field)))
continue; continue;
@ -2938,53 +2948,46 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Make an expression using a PLACEHOLDER_EXPR from the /* Make an expression using a PLACEHOLDER_EXPR from the
FIELD_DECL node just created and link that with the FIELD_DECL node just created and link that with the
corresponding GNAT defining identifier. Then add to the corresponding GNAT defining identifier. */
list of fields. */
save_gnu_tree (gnat_field, save_gnu_tree (gnat_field,
build3 (COMPONENT_REF, TREE_TYPE (gnu_field), build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
build0 (PLACEHOLDER_EXPR, build0 (PLACEHOLDER_EXPR, gnu_type),
DECL_CONTEXT (gnu_field)),
gnu_field, NULL_TREE), gnu_field, NULL_TREE),
true); true);
if (!Is_Unchecked_Union (gnat_entity)) if (!is_unchecked_union)
{ {
TREE_CHAIN (gnu_field) = gnu_field_list; TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field; gnu_field_list = gnu_field;
} }
} }
/* Put the discriminants into the record (backwards), so we can /* Add the fields into the record type and finish it up. */
know the appropriate discriminant to use for the names of the
variants. */
TYPE_FIELDS (gnu_type) = gnu_field_list;
/* Add the listed fields into the record 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, false, all_rep, false, is_unchecked_union);
Is_Unchecked_Union (gnat_entity));
/* We used to remove the associations of the discriminants and /* We used to remove the associations of the discriminants and _Parent
_Parent for validity checking, but we may need them if there's for validity checking but we may need them if there's a Freeze_Node
Freeze_Node for a subtype used in this record. */ for a subtype used in this record. */
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_entity); TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_entity);
/* If it is a tagged record force the type to BLKmode to insure /* If it is a tagged record force the type to BLKmode to insure that
that these objects will always be placed in memory. Do the these objects will always be put in memory. Likewise for limited
same thing for limited record types. */ record types. */
if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity)) if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode); SET_TYPE_MODE (gnu_type, BLKmode);
/* Fill in locations of fields. */ /* Fill in locations of fields. */
annotate_rep (gnat_entity, gnu_type); annotate_rep (gnat_entity, gnu_type);
/* If there are any entities in the chain corresponding to /* If there are any entities in the chain corresponding to components
components that we did not elaborate, ensure we elaborate their that we did not elaborate, ensure we elaborate their types if they
types if they are Itypes. */ are Itypes. */
for (gnat_temp = First_Entity (gnat_entity); for (gnat_temp = First_Entity (gnat_entity);
Present (gnat_temp); gnat_temp = Next_Entity (gnat_temp)) Present (gnat_temp);
gnat_temp = Next_Entity (gnat_temp))
if ((Ekind (gnat_temp) == E_Component if ((Ekind (gnat_temp) == E_Component
|| Ekind (gnat_temp) == E_Discriminant) || Ekind (gnat_temp) == E_Discriminant)
&& Is_Itype (Etype (gnat_temp)) && Is_Itype (Etype (gnat_temp))
@ -3007,7 +3010,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* ... fall through ... */ /* ... fall through ... */
case E_Record_Subtype: case E_Record_Subtype:
/* If Cloned_Subtype is Present it means this record subtype has /* If Cloned_Subtype is Present it means this record subtype has
identical layout to that type or subtype and we should use identical layout to that type or subtype and we should use
that GCC type for this one. The front end guarantees that that GCC type for this one. The front end guarantees that
@ -3017,34 +3019,37 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, 0); NULL_TREE, 0);
maybe_present = true; maybe_present = true;
break;
} }
/* Otherwise, first ensure the base type is elaborated. Then, if we are /* Otherwise, first ensure the base type is elaborated. Then, if we are
changing the type, make a new type with each field having the changing the type, make a new type with each field having the type of
type of the field in the new subtype but having the position the field in the new subtype but the position computed by transforming
computed by transforming every discriminant reference according every discriminant reference according to the constraints. We don't
to the constraints. We don't see any difference between see any difference between private and non-private type here since
private and nonprivate type here since derivations from types should derivations from types should have been deferred until the completion
have been deferred until the completion of the private type. */ of the private type. */
else else
{ {
Entity_Id gnat_base_type = Implementation_Base_Type (gnat_entity); Entity_Id gnat_base_type = Implementation_Base_Type (gnat_entity);
tree gnu_base_type; tree gnu_base_type, gnu_orig_type;
tree gnu_orig_type;
if (!definition) if (!definition)
defer_incomplete_level++, this_deferred = true; {
defer_incomplete_level++;
this_deferred = true;
}
/* Get the base type initially for its alignment and sizes. But /* Get the base type initially for its alignment and sizes.
if it is a padded type, we do all the other work with the But if it is a padded type, we do all the other work with
unpadded type. */ the unpadded type. */
gnu_base_type = gnat_to_gnu_type (gnat_base_type); gnu_base_type = gnat_to_gnu_type (gnat_base_type);
if (TREE_CODE (gnu_base_type) == RECORD_TYPE if (TREE_CODE (gnu_base_type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (gnu_base_type)) && TYPE_IS_PADDING_P (gnu_base_type))
gnu_type = gnu_orig_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type)); gnu_orig_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type));
else else
gnu_type = gnu_orig_type = gnu_base_type; gnu_orig_type = gnu_base_type;
if (present_gnu_tree (gnat_entity)) if (present_gnu_tree (gnat_entity))
{ {
@ -3052,33 +3057,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break; break;
} }
/* When the type has discriminants, and these discriminants /* When the subtype has discriminants and these discriminants affect
affect the shape of what it built, factor them in. the initial shape it has inherited, factor them in. But for the
of an Unchecked_Union (it must be an Itype), just return the type.
If we are making a subtype of an Unchecked_Union (must be an
Itype), just return the type.
We can't just use Is_Constrained because private subtypes without
discriminants of full types with discriminants with default
expressions are Is_Constrained but aren't constrained! */
We can't just test Is_Constrained because private subtypes without
discriminants of types with discriminants with default expressions
are Is_Constrained but aren't constrained! */
if (IN (Ekind (gnat_base_type), Record_Kind) if (IN (Ekind (gnat_base_type), Record_Kind)
&& !Is_For_Access_Subtype (gnat_entity)
&& !Is_Unchecked_Union (gnat_base_type) && !Is_Unchecked_Union (gnat_base_type)
&& !Is_For_Access_Subtype (gnat_entity)
&& Is_Constrained (gnat_entity) && Is_Constrained (gnat_entity)
&& Stored_Constraint (gnat_entity) != No_Elist && Has_Discriminants (gnat_entity)
&& Present (Discriminant_Constraint (gnat_entity))) && Present (Discriminant_Constraint (gnat_entity))
&& Stored_Constraint (gnat_entity) != No_Elist)
{ {
Entity_Id gnat_field;
tree gnu_field_list = 0;
tree gnu_pos_list tree gnu_pos_list
= compute_field_positions (gnu_orig_type, NULL_TREE, = compute_field_positions (gnu_orig_type, NULL_TREE,
size_zero_node, bitsize_zero_node, size_zero_node, bitsize_zero_node,
BIGGEST_ALIGNMENT); BIGGEST_ALIGNMENT);
tree gnu_subst_list tree gnu_subst_list
= substitution_list (gnat_entity, gnat_base_type, NULL_TREE, = build_subst_list (gnat_entity, gnat_base_type, definition);
definition); tree gnu_field_list = NULL_TREE, gnu_temp;
tree gnu_temp; Entity_Id gnat_field;
gnu_type = make_node (RECORD_TYPE); gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_NAME (gnu_type) = gnu_entity_name;
@ -3122,9 +3123,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Present (gnat_field); gnat_field = Next_Entity (gnat_field)) Present (gnat_field); gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component if ((Ekind (gnat_field) == E_Component
|| Ekind (gnat_field) == E_Discriminant) || Ekind (gnat_field) == E_Discriminant)
&& (Underlying_Type (Scope (Original_Record_Component && Underlying_Type (Scope (Original_Record_Component
(gnat_field))) (gnat_field)))
== gnat_base_type) == gnat_base_type
&& (No (Corresponding_Discriminant (gnat_field)) && (No (Corresponding_Discriminant (gnat_field))
|| !Is_Tagged_Type (gnat_base_type))) || !Is_Tagged_Type (gnat_base_type)))
{ {
@ -3192,8 +3193,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TREE_VALUE (gnu_temp)); TREE_VALUE (gnu_temp));
/* If the position is now a constant, we can set it as the /* If the position is now a constant, we can set it as the
position of the field when we make it. Otherwise, we need position of the field when we make it. Otherwise, we
to deal with it specially below. */ need to deal with it specially below. */
if (TREE_CONSTANT (gnu_pos)) if (TREE_CONSTANT (gnu_pos))
{ {
gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos); gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
@ -3309,17 +3310,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
rest_of_record_type_compilation (gnu_type); rest_of_record_type_compilation (gnu_type);
} }
/* Otherwise, go down all the components in the new type and /* Otherwise, go down all the components in the new type and make
make them equivalent to those in the base type. */ them equivalent to those in the base type. */
else else
for (gnat_temp = First_Entity (gnat_entity); Present (gnat_temp); {
gnu_type = gnu_orig_type;
for (gnat_temp = First_Entity (gnat_entity);
Present (gnat_temp);
gnat_temp = Next_Entity (gnat_temp)) gnat_temp = Next_Entity (gnat_temp))
if ((Ekind (gnat_temp) == E_Discriminant if ((Ekind (gnat_temp) == E_Discriminant
&& !Is_Unchecked_Union (gnat_base_type)) && !Is_Unchecked_Union (gnat_base_type))
|| Ekind (gnat_temp) == E_Component) || Ekind (gnat_temp) == E_Component)
save_gnu_tree (gnat_temp, save_gnu_tree (gnat_temp,
gnat_to_gnu_field_decl gnat_to_gnu_field_decl
(Original_Record_Component (gnat_temp)), false); (Original_Record_Component (gnat_temp)),
false);
}
} }
break; break;
@ -3876,10 +3883,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool has_stub = false; bool has_stub = false;
int parmnum; int parmnum;
/* A parameter may refer to this type, so defer completion of any
incomplete types. */
if (kind == E_Subprogram_Type && !definition) if (kind == E_Subprogram_Type && !definition)
/* A parameter may refer to this type, so defer completion {
of any incomplete types. */ defer_incomplete_level++;
defer_incomplete_level++, this_deferred = true; this_deferred = true;
}
/* If the subprogram has an alias, it is probably inherited, so /* If the subprogram has an alias, it is probably inherited, so
we can use the original one. If the original "subprogram" we can use the original one. If the original "subprogram"
@ -5301,13 +5311,14 @@ elaborate_entity (Entity_Id gnat_entity)
case E_Limited_Private_Subtype: case E_Limited_Private_Subtype:
case E_Record_Subtype_With_Private: case E_Record_Subtype_With_Private:
if (Is_Constrained (gnat_entity) if (Is_Constrained (gnat_entity)
&& Has_Discriminants (Base_Type (gnat_entity)) && Has_Discriminants (gnat_entity)
&& Present (Discriminant_Constraint (gnat_entity))) && Present (Discriminant_Constraint (gnat_entity)))
{ {
Node_Id gnat_discriminant_expr; Node_Id gnat_discriminant_expr;
Entity_Id gnat_field; Entity_Id gnat_field;
for (gnat_field = First_Discriminant (Base_Type (gnat_entity)), for (gnat_field
= First_Discriminant (Implementation_Base_Type (gnat_entity)),
gnat_discriminant_expr gnat_discriminant_expr
= First_Elmt (Discriminant_Constraint (gnat_entity)); = First_Elmt (Discriminant_Constraint (gnat_entity));
Present (gnat_field); Present (gnat_field);
@ -5439,25 +5450,20 @@ relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op)
record_component_aliases (gnu_new_type); record_component_aliases (gnu_new_type);
} }
/* Return a TREE_LIST describing the substitutions needed to reflect /* Return a TREE_LIST describing the substitutions needed to reflect the
discriminant substitutions from GNAT_SUBTYPE to GNAT_TYPE and add discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE. They can
them to GNU_LIST. If GNAT_TYPE is not specified, use the base type be in any order. TREE_PURPOSE gives the tree for the discriminant and
of GNAT_SUBTYPE. The substitutions can be in any order. TREE_PURPOSE TREE_VALUE is the replacement value. They are in the form of operands
gives the tree for the discriminant and TREE_VALUES is the replacement to substitute_in_expr. DEFINITION is true if this is for a definition
value. They are in the form of operands to substitute_in_expr. of GNAT_SUBTYPE. */
DEFINITION is as in gnat_to_gnu_entity. */
static tree static tree
substitution_list (Entity_Id gnat_subtype, Entity_Id gnat_type, build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
tree gnu_list, bool definition)
{ {
tree gnu_list = NULL_TREE;
Entity_Id gnat_discrim; Entity_Id gnat_discrim;
Node_Id gnat_value; Node_Id gnat_value;
if (No (gnat_type))
gnat_type = Implementation_Base_Type (gnat_subtype);
if (Has_Discriminants (gnat_type))
for (gnat_discrim = First_Stored_Discriminant (gnat_type), for (gnat_discrim = First_Stored_Discriminant (gnat_type),
gnat_value = First_Elmt (Stored_Constraint (gnat_subtype)); gnat_value = First_Elmt (Stored_Constraint (gnat_subtype));
Present (gnat_discrim); Present (gnat_discrim);
@ -6620,12 +6626,13 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2)); return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2));
} }
/* Return a GCC tree for a record type given a GNAT Component_List and a chain /* Translate and chain the GNAT_COMPONENT_LIST to the GNU_FIELD_LIST, set
of GCC trees for fields that are in the record and have already been the result as the field list of GNU_RECORD_TYPE and finish it up. When
processed. When called from gnat_to_gnu_entity during the processing of a called from gnat_to_gnu_entity during the processing of a record type
record type definition, the GCC nodes for the discriminants will be on definition, the GCC nodes for the discriminants and the parent, if any,
the chain. The other calls to this function are recursive calls from will be on the GNU_FIELD_LIST. The other calls to this function are
itself for the Component_List of a variant and the chain is empty. recursive calls for the component list of a variant and, in this case,
GNU_FIELD_LIST is empty.
PACKED is 1 if this is for a packed record, -1 if this is for a record PACKED is 1 if this is for a packed record, -1 if this is for a record
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
@ -6634,51 +6641,49 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
DEFINITION is true if we are defining this record. DEFINITION is true if we are defining this record.
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. If it is nonzero, that is all that with a rep clause is to be added; in this case, that is all that should
should be done with such fields. be done with such fields.
CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before
laying out the record. This means the alignment only serves to force fields laying out the record. This means the alignment only serves to force
to be bitfields, but not require the record to be that aligned. This is fields to be bitfields, but not require the record to be that aligned.
used for variants. This is used for variants.
ALL_REP, if true, means a rep clause was found for all the fields. This ALL_REP, if true, means a rep clause was found for all the fields. This
simplifies the logic since we know we're not in the mixed case. 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 DO_NOT_FINALIZE, if true, means that the record type is expected to be
modified afterwards so it will not be sent to the back-end for finalization. modified afterwards so it will not be finalized here.
UNCHECKED_UNION, if true, means that we are building a type for a record UNCHECKED_UNION, if true, means that we are building a type for a record
with a Pragma Unchecked_Union. with a Pragma Unchecked_Union. */
The processing of the component list fills in the chain with all of the
fields of the record and then the record type is finished. */
static void static void
components_to_record (tree gnu_record_type, Node_Id 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 unchecked_union) bool all_rep, bool do_not_finalize, bool unchecked_union)
{ {
Node_Id component_decl;
Entity_Id gnat_field;
Node_Id variant_part;
tree gnu_our_rep_list = NULL_TREE;
tree gnu_field, gnu_last;
bool layout_with_rep = false;
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;
Node_Id component_decl, variant_part;
tree gnu_our_rep_list = NULL_TREE;
tree gnu_field, gnu_next, gnu_last;
/* For each variable within each component declaration create a GCC field /* For each component referenced in a component declaration create a GCC
and add it to the list, skipping any pragmas in the list. */ field and add it to the list, skipping pragmas in the GNAT list. */
if (Present (Component_Items (component_list))) if (Present (Component_Items (gnat_component_list)))
for (component_decl = First_Non_Pragma (Component_Items (component_list)); for (component_decl
= First_Non_Pragma (Component_Items (gnat_component_list));
Present (component_decl); Present (component_decl);
component_decl = Next_Non_Pragma (component_decl)) component_decl = Next_Non_Pragma (component_decl))
{ {
gnat_field = Defining_Entity (component_decl); Entity_Id gnat_field = Defining_Entity (component_decl);
/* If present, the _Parent field must have been created and added
as the last field to the list. */
if (Chars (gnat_field) == Name_uParent) if (Chars (gnat_field) == Name_uParent)
gnu_field = tree_last (TYPE_FIELDS (gnu_record_type)); gnu_field = tree_last (gnu_field_list);
else else
{ {
gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type,
@ -6699,7 +6704,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
} }
/* At the end of the component list there may be a variant part. */ /* At the end of the component list there may be a variant part. */
variant_part = Variant_Part (component_list); variant_part = Variant_Part (gnat_component_list);
/* We create a QUAL_UNION_TYPE for the variant part since the variants are /* We create a QUAL_UNION_TYPE for the variant part since the variants are
mutually exclusive and should go in the same memory. To do this we need mutually exclusive and should go in the same memory. To do this we need
@ -6757,14 +6762,14 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
IDENTIFIER_POINTER (gnu_inner_name)); IDENTIFIER_POINTER (gnu_inner_name));
/* Set the alignment of the inner type in case we need to make /* Set the alignment of the inner type in case we need to make
inner objects into bitfields, but then clear it out inner objects into bitfields, but then clear it out so the
so the record actually gets only the alignment required. */ record actually gets only the alignment required. */
TYPE_ALIGN (gnu_variant_type) = TYPE_ALIGN (gnu_record_type); TYPE_ALIGN (gnu_variant_type) = TYPE_ALIGN (gnu_record_type);
TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type); TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type);
/* Similarly, if the outer record has a size specified and all fields /* Similarly, if the outer record has a size specified and all
have record rep clauses, we can propagate the size into the fields have record rep clauses, we can propagate the size
variant part. */ into the variant part. */
if (all_rep_and_size) if (all_rep_and_size)
{ {
TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type); TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type);
@ -6772,8 +6777,8 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
= TYPE_SIZE_UNIT (gnu_record_type); = TYPE_SIZE_UNIT (gnu_record_type);
} }
/* Create the record type for the variant. Note that we defer /* Add the fields into the record type for the variant. Note that we
finalizing it until after we are sure to actually use it. */ defer finalizing it until after we are sure to really use it. */
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,
@ -6821,7 +6826,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
gnu_variant_list = gnu_field; gnu_variant_list = gnu_field;
} }
/* Only make the QUAL_UNION_TYPE if there are any non-empty variants. */ /* Only make the QUAL_UNION_TYPE if there are non-empty variants. */
if (gnu_variant_list) if (gnu_variant_list)
{ {
int union_field_packed; int union_field_packed;
@ -6864,18 +6869,19 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
} }
/* Scan GNU_FIELD_LIST and see if any fields have rep clauses. If they /* Scan GNU_FIELD_LIST and see if any fields have rep clauses. If they
do, pull them out and put them into GNU_OUR_REP_LIST. We have to do this do, pull them out and put them into GNU_OUR_REP_LIST. We have to do
in a separate pass since we want to handle the discriminants but can't this in a separate pass since we want to handle the discriminants but
play with them until we've used them in debugging data above. can't play with them until we've used them in debugging data above.
??? Note: if we then reorder them, debugging information will be wrong, ??? If we then reorder them, debugging information will be wrong but
but there's nothing that can be done about this at the moment. */ there's nothing that can be done about this at the moment. */
for (gnu_field = gnu_field_list, gnu_last = NULL_TREE; gnu_field; ) gnu_last = NULL_TREE;
for (gnu_field = gnu_field_list; gnu_field; gnu_field = gnu_next)
{ {
gnu_next = TREE_CHAIN (gnu_field);
if (DECL_FIELD_OFFSET (gnu_field)) if (DECL_FIELD_OFFSET (gnu_field))
{ {
tree gnu_next = TREE_CHAIN (gnu_field);
if (!gnu_last) if (!gnu_last)
gnu_field_list = gnu_next; gnu_field_list = gnu_next;
else else
@ -6883,31 +6889,28 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
TREE_CHAIN (gnu_field) = gnu_our_rep_list; TREE_CHAIN (gnu_field) = gnu_our_rep_list;
gnu_our_rep_list = gnu_field; gnu_our_rep_list = gnu_field;
gnu_field = gnu_next;
} }
else else
{
gnu_last = gnu_field; gnu_last = gnu_field;
gnu_field = TREE_CHAIN (gnu_field);
}
} }
/* If we have any items in our rep'ed field list, it is not the case that all /* If we have any fields in our rep'ed field list and it is not the case that
the fields in the record have rep clauses, and P_REP_LIST is nonzero, all the fields in the record have rep clauses and P_REP_LIST is nonzero,
set it and ignore the items. */ set it and ignore these fields. */
if (gnu_our_rep_list && p_gnu_rep_list && !all_rep) if (gnu_our_rep_list && p_gnu_rep_list && !all_rep)
*p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_our_rep_list); *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_our_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. */
else if (gnu_our_rep_list) else if (gnu_our_rep_list)
{ {
/* Otherwise, sort the fields by bit position and put them into their
own record if we have any fields without rep clauses. */
tree gnu_rep_type tree gnu_rep_type
= (gnu_field_list ? make_node (RECORD_TYPE) : gnu_record_type); = (gnu_field_list ? make_node (RECORD_TYPE) : gnu_record_type);
int len = list_length (gnu_our_rep_list); int i, len = list_length (gnu_our_rep_list);
tree *gnu_arr = (tree *) alloca (sizeof (tree) * len); tree *gnu_arr = (tree *) alloca (sizeof (tree) * len);
int i;
for (i = 0, gnu_field = gnu_our_rep_list; gnu_field; for (gnu_field = gnu_our_rep_list, i = 0;
gnu_field;
gnu_field = TREE_CHAIN (gnu_field), i++) gnu_field = TREE_CHAIN (gnu_field), i++)
gnu_arr[i] = gnu_field; gnu_arr[i] = gnu_field;
@ -6926,8 +6929,9 @@ components_to_record (tree gnu_record_type, Node_Id 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, false);
gnu_field = create_field_decl (get_identifier ("REP"), gnu_rep_type, gnu_field
gnu_record_type, 0, 0, 0, 1); = create_field_decl (get_identifier ("REP"), gnu_rep_type,
gnu_record_type, 0, NULL_TREE, NULL_TREE, 1);
DECL_INTERNAL_P (gnu_field) = 1; DECL_INTERNAL_P (gnu_field) = 1;
gnu_field_list = chainon (gnu_field_list, gnu_field); gnu_field_list = chainon (gnu_field_list, gnu_field);
} }