Commit 1bbf8502 by Duncan Sands Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Use pointers to dummy nodes...

	* decl.c (gnat_to_gnu_entity): Use pointers to dummy nodes, rather
	than to void, for the fields when making a new fat pointer type.
	(gnat_substitute_in_type): Now substitute_in_type.
	* gigi.h (gnat_substitute_in_type): Likewise.
	* trans.c (gnat_gimplify_expr): Remove COMPONENT_REF kludge.
	* utils.c (update_pointer_to): Update fat pointers by updating the
	dummy node pointers used for the fields.

From-SVN: r125602
parent 55edccf4
2007-06-10 Duncan Sands <baldrick@free.fr>
* decl.c (gnat_to_gnu_entity): Use pointers to dummy nodes, rather
than to void, for the fields when making a new fat pointer type.
(gnat_substitute_in_type): Now substitute_in_type.
* gigi.h (gnat_substitute_in_type): Likewise.
* trans.c (gnat_gimplify_expr): Remove COMPONENT_REF kludge.
* utils.c (update_pointer_to): Update fat pointers by updating the
dummy node pointers used for the fields.
2007-06-06 Thomas Quinot <quinot@adacore.com> 2007-06-06 Thomas Quinot <quinot@adacore.com>
Bob Duff <duff@adacore.com> Bob Duff <duff@adacore.com>
...@@ -3041,13 +3041,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3041,13 +3041,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& ! 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 instead of a pointer unconstrained array, make a fat pointer type. The two types in our
to VOID. The two types in our fields will be pointers to VOID and fields will be pointers to dummy nodes and will be replaced in
will be replaced in update_pointer_to. Similarly, if the type update_pointer_to. Similarly, if the type itself is a dummy type or
itself is a dummy type or an unconstrained array. Also make an unconstrained array. Also make a dummy TYPE_OBJECT_RECORD_TYPE
a dummy TYPE_OBJECT_RECORD_TYPE in case we have any thin in case we have any thin pointers to it. */
pointers to it. */
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)
...@@ -3075,6 +3073,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3075,6 +3073,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = TYPE_POINTER_TO (gnu_old); gnu_type = TYPE_POINTER_TO (gnu_old);
if (!gnu_type) if (!gnu_type)
{ {
tree gnu_template_type = make_node (ENUMERAL_TYPE);
tree gnu_ptr_template = build_pointer_type (gnu_template_type);
tree gnu_array_type = make_node (ENUMERAL_TYPE);
tree gnu_ptr_array = build_pointer_type (gnu_array_type);
TYPE_NAME (gnu_template_type)
= concat_id_with_name (get_entity_name (gnat_desig_equiv),
"XUB");
TYPE_DUMMY_P (gnu_template_type) = 1;
TYPE_NAME (gnu_array_type)
= concat_id_with_name (get_entity_name (gnat_desig_equiv),
"XUA");
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_old);
TYPE_POINTER_TO (gnu_old) = gnu_type; TYPE_POINTER_TO (gnu_old) = gnu_type;
...@@ -3084,10 +3097,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3084,10 +3097,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= chainon (chainon (NULL_TREE, = chainon (chainon (NULL_TREE,
create_field_decl create_field_decl
(get_identifier ("P_ARRAY"), (get_identifier ("P_ARRAY"),
ptr_void_type_node, gnu_type, gnu_ptr_array,
0, 0, 0, 0)), gnu_type, 0, 0, 0, 0)),
create_field_decl (get_identifier ("P_BOUNDS"), create_field_decl (get_identifier ("P_BOUNDS"),
ptr_void_type_node, gnu_ptr_template,
gnu_type, 0, 0, 0, 0)); gnu_type, 0, 0, 0, 0));
/* Make sure we can place this into a register. */ /* Make sure we can place this into a register. */
...@@ -6846,14 +6859,13 @@ compatible_signatures_p (tree ftype1, tree ftype2) ...@@ -6846,14 +6859,13 @@ compatible_signatures_p (tree ftype1, tree ftype2)
return 1; return 1;
} }
/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
with all size expressions that contain F updated by replacing F with R. type with all size expressions that contain F updated by replacing F
This is identical to GCC's substitute_in_type except that it knows about with R. If F is NULL_TREE, always make a new RECORD_TYPE, even if
TYPE_INDEX_TYPE. If F is NULL_TREE, always make a new RECORD_TYPE, even if
nothing has changed. */ nothing has changed. */
tree tree
gnat_substitute_in_type (tree t, tree f, tree r) substitute_in_type (tree t, tree f, tree r)
{ {
tree new = t; tree new = t;
tree tem; tree tem;
...@@ -6875,7 +6887,7 @@ gnat_substitute_in_type (tree t, tree f, tree r) ...@@ -6875,7 +6887,7 @@ gnat_substitute_in_type (tree t, tree f, tree r)
new = build_range_type (TREE_TYPE (t), low, high); new = build_range_type (TREE_TYPE (t), low, high);
if (TYPE_INDEX_TYPE (t)) if (TYPE_INDEX_TYPE (t))
SET_TYPE_INDEX_TYPE SET_TYPE_INDEX_TYPE
(new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); (new, substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
return new; return new;
} }
...@@ -6902,7 +6914,7 @@ gnat_substitute_in_type (tree t, tree f, tree r) ...@@ -6902,7 +6914,7 @@ gnat_substitute_in_type (tree t, tree f, tree r)
return t; return t;
case COMPLEX_TYPE: case COMPLEX_TYPE:
tem = gnat_substitute_in_type (TREE_TYPE (t), f, r); tem = substitute_in_type (TREE_TYPE (t), f, r);
if (tem == TREE_TYPE (t)) if (tem == TREE_TYPE (t))
return t; return t;
...@@ -6917,8 +6929,8 @@ gnat_substitute_in_type (tree t, tree f, tree r) ...@@ -6917,8 +6929,8 @@ gnat_substitute_in_type (tree t, tree f, tree r)
case ARRAY_TYPE: case ARRAY_TYPE:
{ {
tree component = gnat_substitute_in_type (TREE_TYPE (t), f, r); tree component = substitute_in_type (TREE_TYPE (t), f, r);
tree domain = gnat_substitute_in_type (TYPE_DOMAIN (t), f, r); tree domain = substitute_in_type (TYPE_DOMAIN (t), f, r);
if (component == TREE_TYPE (t) && domain == TYPE_DOMAIN (t)) if (component == TREE_TYPE (t) && domain == TYPE_DOMAIN (t))
return t; return t;
...@@ -6968,7 +6980,7 @@ gnat_substitute_in_type (tree t, tree f, tree r) ...@@ -6968,7 +6980,7 @@ gnat_substitute_in_type (tree t, tree f, tree r)
tree new_field = copy_node (field); tree new_field = copy_node (field);
TREE_TYPE (new_field) TREE_TYPE (new_field)
= gnat_substitute_in_type (TREE_TYPE (new_field), f, r); = substitute_in_type (TREE_TYPE (new_field), f, r);
if (DECL_HAS_REP_P (field) && !DECL_INTERNAL_P (field)) if (DECL_HAS_REP_P (field) && !DECL_INTERNAL_P (field))
field_has_rep = true; field_has_rep = true;
......
...@@ -160,11 +160,11 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -160,11 +160,11 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align,
the value passed against the list of choices. */ the value passed against the list of choices. */
extern tree choices_to_gnu (tree operand, Node_Id choices); extern tree choices_to_gnu (tree operand, Node_Id choices);
/* Given a type T, a FIELD_DECL F, and a replacement value R, /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
return a new type with all size expressions that contain F type with all size expressions that contain F updated by replacing F
updated by replacing F with R. This is identical to GCC's with R. If F is NULL_TREE, always make a new RECORD_TYPE, even if
substitute_in_type except that it knows about TYPE_INDEX_TYPE. */ nothing has changed. */
extern tree gnat_substitute_in_type (tree t, tree f, tree r); extern tree substitute_in_type (tree t, tree f, tree r);
/* Return the "RM size" of GNU_TYPE. This is the actual number of bits /* Return the "RM size" of GNU_TYPE. This is the actual number of bits
needed to represent the object. */ needed to represent the object. */
......
...@@ -5201,19 +5201,6 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED) ...@@ -5201,19 +5201,6 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED)
return GS_ALL_DONE; return GS_ALL_DONE;
} }
return GS_UNHANDLED;
case COMPONENT_REF:
/* We have a kludge here. If the FIELD_DECL is from a fat pointer and is
from an early dummy type, replace it with the proper FIELD_DECL. */
if (TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (*expr_p, 0)))
&& DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1)))
{
TREE_OPERAND (*expr_p, 1)
= DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1));
return GS_OK;
}
/* ... fall through ... */ /* ... fall through ... */
default: default:
......
...@@ -3160,75 +3160,64 @@ update_pointer_to (tree old_type, tree new_type) ...@@ -3160,75 +3160,64 @@ update_pointer_to (tree old_type, tree new_type)
} }
/* Now deal with the unconstrained array case. In this case the "pointer" /* Now deal with the unconstrained array case. In this case the "pointer"
is actually a RECORD_TYPE where the types of both fields are is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
pointers to void. In that case, copy the field list from the Turn them into pointers to the correct types using update_pointer_to. */
old type to the new one and update the fields' context. */
else if (TREE_CODE (ptr) != RECORD_TYPE || !TYPE_IS_FAT_POINTER_P (ptr)) else if (TREE_CODE (ptr) != RECORD_TYPE || !TYPE_IS_FAT_POINTER_P (ptr))
gcc_unreachable (); gcc_unreachable ();
else else
{ {
tree new_obj_rec = TYPE_OBJECT_RECORD_TYPE (new_type); tree new_obj_rec = TYPE_OBJECT_RECORD_TYPE (new_type);
tree fields = TYPE_FIELDS (TYPE_POINTER_TO (new_type)); tree array_field = TYPE_FIELDS (ptr);
tree new_fields, ptr_temp_type, new_ref, bounds, var; tree bounds_field = TREE_CHAIN (TYPE_FIELDS (ptr));
tree new_ptr = TYPE_POINTER_TO (new_type);
/* Replace contents of old pointer with those of new pointer. */ tree new_ref;
new_fields = copy_node (fields); tree var;
TREE_CHAIN (new_fields) = copy_node (TREE_CHAIN (fields));
/* Make pointers to the dummy template point to the real template. */
SET_DECL_ORIGINAL_FIELD (TYPE_FIELDS (ptr), new_fields); update_pointer_to
SET_DECL_ORIGINAL_FIELD (TREE_CHAIN (TYPE_FIELDS (ptr)), (TREE_TYPE (TREE_TYPE (bounds_field)),
TREE_CHAIN (new_fields)); TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_ptr)))));
TYPE_FIELDS (ptr) = new_fields; /* The references to the template bounds present in the array type
DECL_CONTEXT (new_fields) = ptr; are made through a PLACEHOLDER_EXPR of type new_ptr. Since we
DECL_CONTEXT (TREE_CHAIN (new_fields)) = ptr; are updating ptr to make it a full replacement for new_ptr as
pointer to new_type, we must rework the PLACEHOLDER_EXPR so as
/* Rework the PLACEHOLDER_EXPR inside the reference to the template to make it of type ptr. */
bounds and update the pointers to them. new_ref = build3 (COMPONENT_REF, TREE_TYPE (bounds_field),
??? This is now the only use of gnat_substitute_in_type, which
is now a very "heavy" routine to do this, so it should be replaced
at some point. */
bounds = TREE_TYPE (TREE_TYPE (new_fields));
ptr_temp_type = TREE_TYPE (TREE_CHAIN (new_fields));
new_ref = build3 (COMPONENT_REF, ptr_temp_type,
build0 (PLACEHOLDER_EXPR, ptr), build0 (PLACEHOLDER_EXPR, ptr),
TREE_CHAIN (new_fields), NULL_TREE); bounds_field, NULL_TREE);
update_pointer_to (bounds,
gnat_substitute_in_type (bounds,
TREE_CHAIN (fields),
new_ref));
for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var)) /* Create the new array for the new PLACEHOLDER_EXPR and make
{ pointers to the dummy array point to it.
SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
/* This may seem a bit gross, in particular wrt DECL_CONTEXT, but ??? This is now the only use of substitute_in_type,
actually is in keeping with what build_qualified_type does. */ which is a very "heavy" routine to do this, so it
TYPE_FIELDS (var) = new_fields; should be replaced at some point. */
} update_pointer_to
(TREE_TYPE (TREE_TYPE (array_field)),
substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr))),
TREE_CHAIN (TYPE_FIELDS (new_ptr)), new_ref));
/* Make ptr the pointer to new_type. */
TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type) TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
= TREE_TYPE (new_type) = ptr; = TREE_TYPE (new_type) = ptr;
for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
/* Now handle updating the allocation record, what the thin pointer /* Now handle updating the allocation record, what the thin pointer
points to. Update all pointers from the old record into the new points to. Update all pointers from the old record into the new
one, update the types of the fields, and recompute the size. */ one, update the type of the array field, and recompute the size. */
update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), new_obj_rec); update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), new_obj_rec);
TREE_TYPE (TYPE_FIELDS (new_obj_rec))
= TREE_TYPE (TREE_TYPE (TREE_CHAIN (new_fields)));
TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec)))
= TREE_TYPE (TREE_TYPE (new_fields)); = TREE_TYPE (TREE_TYPE (array_field));
/* The size recomputation needs to account for alignment constraints, so /* The size recomputation needs to account for alignment constraints, so
we let layout_type work it out. This will reset the field offsets to we let layout_type work it out. This will reset the field offsets to
what they would be in a regular record, so we shift them back to what what they would be in a regular record, so we shift them back to what
we want them to be for a thin pointer designated type afterwards. */ we want them to be for a thin pointer designated type afterwards. */
DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = 0; DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = 0;
DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = 0; DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = 0;
TYPE_SIZE (new_obj_rec) = 0; TYPE_SIZE (new_obj_rec) = 0;
......
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