Commit d0c26312 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Tidy up code, improve comments and fix formatting nits.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Access_Type>: Tidy up
	code, improve comments and fix formatting nits.

From-SVN: r159312
parent 101422f0
2010-05-12 Eric Botcazou <ebotcazou@adacore.com> 2010-05-12 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Access_Type>: Tidy up
code, improve comments and fix formatting nits.
2010-05-12 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (update_pointer_to): Return early if the old * gcc-interface/utils.c (update_pointer_to): Return early if the old
pointer already points to the new type. Chain the old pointer and its pointer already points to the new type. Chain the old pointer and its
variants at the end of new pointer's chain after updating them. variants at the end of new pointer's chain after updating them.
......
...@@ -3358,13 +3358,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3358,13 +3358,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Anonymous_Access_Type: case E_Anonymous_Access_Type:
case E_General_Access_Type: case E_General_Access_Type:
{ {
/* The designated type and its equivalent type for gigi. */
Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity); Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity);
Entity_Id gnat_desig_equiv = Gigi_Equivalent_Type (gnat_desig_type); Entity_Id gnat_desig_equiv = Gigi_Equivalent_Type (gnat_desig_type);
/* Whether it comes from a limited with. */
bool is_from_limited_with bool is_from_limited_with
= (IN (Ekind (gnat_desig_equiv), Incomplete_Kind) = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
&& From_With_Type (gnat_desig_equiv)); && From_With_Type (gnat_desig_equiv));
/* The "full view" of the designated type. If this is an incomplete
/* Get the "full view" of this entity. If this is an incomplete
entity from a limited with, treat its non-limited view as the full entity from a limited with, treat its non-limited view as the full
view. Otherwise, if this is an incomplete or private type, use the view. Otherwise, if this is an incomplete or private type, use the
full view. In the former case, we might point to a private type, full view. In the former case, we might point to a private type,
...@@ -3372,7 +3373,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3372,7 +3373,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
actual type used for the representation, so this takes a total of actual type used for the representation, so this takes a total of
three steps. */ three steps. */
Entity_Id gnat_desig_full_direct_first Entity_Id gnat_desig_full_direct_first
= (is_from_limited_with ? Non_Limited_View (gnat_desig_equiv) = (is_from_limited_with
? Non_Limited_View (gnat_desig_equiv)
: (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind) : (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind)
? Full_View (gnat_desig_equiv) : Empty)); ? Full_View (gnat_desig_equiv) : Empty));
Entity_Id gnat_desig_full_direct Entity_Id gnat_desig_full_direct
...@@ -3383,27 +3385,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3383,27 +3385,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
: gnat_desig_full_direct_first); : gnat_desig_full_direct_first);
Entity_Id gnat_desig_full Entity_Id gnat_desig_full
= Gigi_Equivalent_Type (gnat_desig_full_direct); = Gigi_Equivalent_Type (gnat_desig_full_direct);
/* The type actually used to represent the designated type, either
/* This the type actually used to represent the designated type, gnat_desig_full or gnat_desig_equiv. */
either gnat_desig_full or gnat_desig_equiv. */
Entity_Id gnat_desig_rep; Entity_Id gnat_desig_rep;
/* True if this is a pointer to an unconstrained array. */ /* True if this is a pointer to an unconstrained array. */
bool is_unconstrained_array; bool is_unconstrained_array;
/* We want to know if we'll be seeing the freeze node for any /* We want to know if we'll be seeing the freeze node for any
incomplete type we may be pointing to. */ incomplete type we may be pointing to. */
bool in_main_unit bool in_main_unit
= (Present (gnat_desig_full) = (Present (gnat_desig_full)
? In_Extended_Main_Code_Unit (gnat_desig_full) ? In_Extended_Main_Code_Unit (gnat_desig_full)
: In_Extended_Main_Code_Unit (gnat_desig_type)); : In_Extended_Main_Code_Unit (gnat_desig_type));
/* True if we make a dummy type here. */ /* True if we make a dummy type here. */
bool got_fat_p = false;
/* True if the dummy is a fat pointer. */
bool made_dummy = false; bool made_dummy = false;
tree gnu_desig_type = NULL_TREE; /* True if the dummy type is a fat pointer. */
bool got_fat_p = false;
/* The mode to be used for the pointer type. */
enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0); enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
/* The GCC type used for the designated type. */
tree gnu_desig_type = NULL_TREE;
if (!targetm.valid_pointer_mode (p_mode)) if (!targetm.valid_pointer_mode (p_mode))
p_mode = ptr_mode; p_mode = ptr_mode;
...@@ -3416,22 +3416,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3416,22 +3416,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
issues. This can lose some code efficiency, but there is no issues. This can lose some code efficiency, but there is no
alternative. */ alternative. */
if (Ekind (gnat_desig_equiv) == E_Array_Subtype if (Ekind (gnat_desig_equiv) == E_Array_Subtype
&& ! Is_Constrained (gnat_desig_equiv)) && !Is_Constrained (gnat_desig_equiv))
gnat_desig_equiv = Etype (gnat_desig_equiv); gnat_desig_equiv = Etype (gnat_desig_equiv);
if (Present (gnat_desig_full) if (Present (gnat_desig_full)
&& ((Ekind (gnat_desig_full) == E_Array_Subtype && ((Ekind (gnat_desig_full) == E_Array_Subtype
&& ! Is_Constrained (gnat_desig_full)) && !Is_Constrained (gnat_desig_full))
|| (Ekind (gnat_desig_full) == E_Record_Subtype || (Ekind (gnat_desig_full) == E_Record_Subtype
&& Ekind (Etype (gnat_desig_full)) == E_Record_Type))) && Ekind (Etype (gnat_desig_full)) == E_Record_Type)))
gnat_desig_full = Etype (gnat_desig_full); gnat_desig_full = Etype (gnat_desig_full);
/* Now set the type that actually marks the representation of /* Set the type that's actually the representation of the designated
the designated type and also flag whether we have a unconstrained type and also flag whether we have a unconstrained array. */
array. */ gnat_desig_rep
gnat_desig_rep = gnat_desig_full ? gnat_desig_full : gnat_desig_equiv; = Present (gnat_desig_full) ? gnat_desig_full : gnat_desig_equiv;
is_unconstrained_array is_unconstrained_array
= (Is_Array_Type (gnat_desig_rep) = Is_Array_Type (gnat_desig_rep) && !Is_Constrained (gnat_desig_rep);
&& ! Is_Constrained (gnat_desig_rep));
/* If we are pointing to an incomplete type whose completion is an /* If we are pointing to an incomplete type whose completion is an
unconstrained array, make a fat pointer type. The two types in our unconstrained array, make a fat pointer type. The two types in our
...@@ -3442,31 +3441,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3442,31 +3441,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (is_unconstrained_array if (is_unconstrained_array
&& (Present (gnat_desig_full) && (Present (gnat_desig_full)
|| (present_gnu_tree (gnat_desig_equiv) || (present_gnu_tree (gnat_desig_equiv)
&& TYPE_IS_DUMMY_P (TREE_TYPE && TYPE_IS_DUMMY_P
(get_gnu_tree (gnat_desig_equiv)))) (TREE_TYPE (get_gnu_tree (gnat_desig_equiv))))
|| (No (gnat_desig_full) && ! in_main_unit || (!in_main_unit
&& defer_incomplete_level != 0 && defer_incomplete_level
&& ! present_gnu_tree (gnat_desig_equiv)) && !present_gnu_tree (gnat_desig_equiv))
|| (in_main_unit && is_from_limited_with || (in_main_unit
&& Present (Freeze_Node (gnat_desig_rep))))) && is_from_limited_with
&& Present (Freeze_Node (gnat_desig_equiv)))))
{ {
tree gnu_old;
if (present_gnu_tree (gnat_desig_rep)) if (present_gnu_tree (gnat_desig_rep))
gnu_old = TREE_TYPE (get_gnu_tree (gnat_desig_rep)); gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
else else
{ {
gnu_old = make_dummy_type (gnat_desig_rep); gnu_desig_type = make_dummy_type (gnat_desig_rep);
/* Show the dummy we get will be a fat pointer. */ /* Show the dummy we get will be a fat pointer. */
got_fat_p = made_dummy = true; got_fat_p = made_dummy = true;
} }
/* If the call above got something that has a pointer, that /* If the call above got something that has a pointer, the pointer
pointer is our type. This could have happened either is our type. This could have happened either because the type
because the type was elaborated or because somebody was elaborated or because somebody else executed the code. */
else executed the code below. */ gnu_type = TYPE_POINTER_TO (gnu_desig_type);
gnu_type = TYPE_POINTER_TO (gnu_old);
if (!gnu_type) if (!gnu_type)
{ {
tree gnu_template_type = make_node (ENUMERAL_TYPE); tree gnu_template_type = make_node (ENUMERAL_TYPE);
...@@ -3484,18 +3480,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3484,18 +3480,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_DUMMY_P (gnu_array_type) = 1; TYPE_DUMMY_P (gnu_array_type) = 1;
gnu_type = make_node (RECORD_TYPE); gnu_type = make_node (RECORD_TYPE);
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old); SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_desig_type);
TYPE_POINTER_TO (gnu_old) = gnu_type; TYPE_POINTER_TO (gnu_desig_type) = gnu_type;
fields fields
= chainon (chainon (NULL_TREE, = create_field_decl (get_identifier ("P_ARRAY"),
create_field_decl
(get_identifier ("P_ARRAY"),
gnu_ptr_array, gnu_type, gnu_ptr_array, gnu_type,
NULL_TREE, NULL_TREE, 0, 0)), NULL_TREE, NULL_TREE, 0, 0);
create_field_decl (get_identifier ("P_BOUNDS"), TREE_CHAIN (fields)
gnu_ptr_template, gnu_type, = create_field_decl (get_identifier ("P_BOUNDS"),
NULL_TREE, NULL_TREE, 0, 0)); gnu_ptr_template, gnu_type,
NULL_TREE, NULL_TREE, 0, 0);
/* Make sure we can place this into a register. */ /* Make sure we can place this into a register. */
TYPE_ALIGN (gnu_type) TYPE_ALIGN (gnu_type)
...@@ -3506,10 +3501,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3506,10 +3501,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
of its fields are incomplete. */ of its fields are incomplete. */
finish_record_type (gnu_type, fields, 0, false); finish_record_type (gnu_type, fields, 0, false);
TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE); TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)
TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = make_node (RECORD_TYPE);
TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type))
= create_concat_name (gnat_desig_equiv, "XUT"); = create_concat_name (gnat_desig_equiv, "XUT");
TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = 1; TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)) = 1;
} }
} }
...@@ -3518,35 +3514,35 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3518,35 +3514,35 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& present_gnu_tree (gnat_desig_full)) && present_gnu_tree (gnat_desig_full))
gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full)); gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full));
/* Get the type of the thing we are to point to and build a pointer /* Get the type of the thing we are to point to and build a pointer to
to it. If it is a reference to an incomplete or private type with a it. If it is a reference to an incomplete or private type with a
full view that is a record, make a dummy type node and get the full view that is a record, make a dummy type node and get the
actual type later when we have verified it is safe. */ actual type later when we have verified it is safe. */
else if ((! in_main_unit else if ((!in_main_unit
&& ! present_gnu_tree (gnat_desig_equiv) && !present_gnu_tree (gnat_desig_equiv)
&& Present (gnat_desig_full) && Present (gnat_desig_full)
&& ! present_gnu_tree (gnat_desig_full) && !present_gnu_tree (gnat_desig_full)
&& Is_Record_Type (gnat_desig_full)) && Is_Record_Type (gnat_desig_full))
/* Likewise if we are pointing to a record or array and we /* Likewise if we are pointing to a record or array and we are
are to defer elaborating incomplete types. We do this to defer elaborating incomplete types. We do this as this
since this access type may be the full view of some access type may be the full view of a private type. Note
private type. Note that the unconstrained array case is that the unconstrained array case is handled above. */
handled above. */ || ((!in_main_unit || imported_p)
|| ((! in_main_unit || imported_p) && defer_incomplete_level
&& defer_incomplete_level != 0 && !present_gnu_tree (gnat_desig_equiv)
&& ! present_gnu_tree (gnat_desig_equiv) && (Is_Record_Type (gnat_desig_rep)
&& ((Is_Record_Type (gnat_desig_rep) || Is_Array_Type (gnat_desig_rep)))
|| Is_Array_Type (gnat_desig_rep))))
/* If this is a reference from a limited_with type back to our /* If this is a reference from a limited_with type back to our
main unit and there's a Freeze_Node for it, either we have main unit and there's a freeze node for it, either we have
already processed the declaration and made the dummy type, already processed the declaration and made the dummy type,
in which case we just reuse the latter, or we have not yet, in which case we just reuse the latter, or we have not yet,
in which case we make the dummy type and it will be reused in which case we make the dummy type and it will be reused
when the declaration is processed. In both cases, the when the declaration is finally processed. In both cases,
pointer eventually created below will be automatically the pointer eventually created below will be automatically
adjusted when the Freeze_Node is processed. Note that the adjusted when the freeze node is processed. Note that the
unconstrained array case is handled above. */ unconstrained array case is handled above. */
|| (in_main_unit && is_from_limited_with || (in_main_unit
&& is_from_limited_with
&& Present (Freeze_Node (gnat_desig_rep)))) && Present (Freeze_Node (gnat_desig_rep))))
{ {
gnu_desig_type = make_dummy_type (gnat_desig_equiv); gnu_desig_type = make_dummy_type (gnat_desig_equiv);
...@@ -3562,13 +3558,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3562,13 +3558,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type; TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
} }
/* If expansion is disabled, the equivalent type of a concurrent /* If expansion is disabled, the equivalent type of a concurrent type
type is absent, so build a dummy pointer type. */ is absent, so build a dummy pointer type. */
else if (type_annotate_only && No (gnat_desig_equiv)) else if (type_annotate_only && No (gnat_desig_equiv))
gnu_type = ptr_void_type_node; gnu_type = ptr_void_type_node;
/* Finally, handle the straightforward case where we can just /* Finally, handle the default case where we can just elaborate our
elaborate our designated type and point to it. */ designated type. */
else else
gnu_desig_type = gnat_to_gnu_type (gnat_desig_equiv); gnu_desig_type = gnat_to_gnu_type (gnat_desig_equiv);
...@@ -3580,11 +3576,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3580,11 +3576,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break; break;
} }
/* If we have a GCC type for the designated type, possibly modify it /* If we have not done it yet, build the pointer type the usual way. */
if we are pointing only to constant objects and then make a pointer if (!gnu_type)
to it. Don't do this for unconstrained arrays. */
if (!gnu_type && gnu_desig_type)
{ {
/* Modify the designated type if we are pointing only to constant
objects, but don't do it for unconstrained arrays. */
if (Is_Access_Constant (gnat_entity) if (Is_Access_Constant (gnat_entity)
&& TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE) && TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE)
{ {
...@@ -3623,17 +3619,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3623,17 +3619,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
No_Strict_Aliasing (gnat_entity)); No_Strict_Aliasing (gnat_entity));
} }
/* If we are not defining this object and we made a dummy pointer, /* If we are not defining this object and we have made a dummy pointer,
save our current definition, evaluate the actual type, and replace save our current definition, evaluate the actual type, and replace
the tentative type we made with the actual one. If we are to defer the tentative type we made with the actual one. If we are to defer
actually looking up the actual type, make an entry in the actually looking up the actual type, make an entry in the deferred
deferred list. If this is from a limited with, we have to defer list. If this is from a limited with, we have to defer to the end
to the end of the current spec in two cases: first if the of the current spec in two cases: first if the designated type is
designated type is in the current unit and second if the access in the current unit and second if the access type itself is. */
type is. */ if ((!in_main_unit || is_from_limited_with) && made_dummy)
if ((! in_main_unit || is_from_limited_with) && made_dummy)
{ {
tree gnu_old_type bool is_from_limited_with_in_main_unit
= (is_from_limited_with
&& (in_main_unit
|| In_Extended_Main_Code_Unit (gnat_entity)));
tree gnu_old_desig_type
= TYPE_IS_FAT_POINTER_P (gnu_type) = TYPE_IS_FAT_POINTER_P (gnu_type)
? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type); ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
...@@ -3652,37 +3651,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3652,37 +3651,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
save_gnu_tree (gnat_entity, gnu_decl, false); save_gnu_tree (gnat_entity, gnu_decl, false);
saved = true; saved = true;
if (defer_incomplete_level == 0 /* Note that the call to gnat_to_gnu_type on gnat_desig_equiv might
&& ! (is_from_limited_with update gnu_old_desig_type directly, in which case it will not be
&& (in_main_unit a dummy type any more when we get into update_pointer_to.
|| In_Extended_Main_Code_Unit (gnat_entity))))
update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
gnat_to_gnu_type (gnat_desig_equiv));
/* Note that the call to gnat_to_gnu_type here might have
updated gnu_old_type directly, in which case it is not a
dummy type any more when we get into update_pointer_to.
This may happen for instance when the designated type is a This can happen e.g. when the designated type is a record type,
record type, because their elaboration starts with an because their elaboration starts with an initial node from
initial node from make_dummy_type, which may yield the same make_dummy_type, which may be the same node as the one we got.
node as the one we got.
Besides, variants of this non-dummy type might have been Besides, variants of this non-dummy type might have been created
created along the way. update_pointer_to is expected to along the way. update_pointer_to is expected to properly take
properly take care of those situations. */ care of those situations. */
if (!defer_incomplete_level && !is_from_limited_with_in_main_unit)
update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type),
gnat_to_gnu_type (gnat_desig_equiv));
else else
{ {
struct incomplete *p struct incomplete *p = XNEW (struct incomplete);
= (struct incomplete *) xmalloc (sizeof
(struct incomplete));
struct incomplete **head struct incomplete **head
= (is_from_limited_with = (is_from_limited_with_in_main_unit
&& (in_main_unit
|| In_Extended_Main_Code_Unit (gnat_entity))
? &defer_limited_with : &defer_incomplete_list); ? &defer_limited_with : &defer_incomplete_list);
p->old_type = gnu_old_desig_type;
p->old_type = gnu_old_type;
p->full_type = gnat_desig_equiv; p->full_type = gnat_desig_equiv;
p->next = *head; p->next = *head;
*head = p; *head = p;
......
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