@@ -2099,16 +2099,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* Array Types and Subtypes
- Unconstrained array types are represented by E_Array_Type and
- constrained array types are represented by E_Array_Subtype. There
- are no actual objects of an unconstrained array type; all we have
- are pointers to that type.
+ In GNAT unconstrained array types are represented by E_Array_Type and
+ constrained array types are represented by E_Array_Subtype. They are
+ translated into UNCONSTRAINED_ARRAY_TYPE and ARRAY_TYPE respectively.
+ But there are no actual objects of an unconstrained array type; all we
+ have are pointers to that type. In addition to the type node itself,
+ 4 other types associated with it are built in the process:
- The following fields are defined on array types and subtypes:
+ 1. the array type (suffix XUA) containing the actual data,
- Component_Type Component type of the array.
- Number_Dimensions Number of dimensions (an int).
- First_Index Type of first index. */
+ 2. the template type (suffix XUB) containng the bounds,
+
+ 3. the fat pointer type (suffix XUP) representing a pointer or a
+ reference to the unconstrained array type:
+ XUP = struct { XUA *, XUB * }
+
+ 4. the object record type (suffix XUT) containing bounds and data:
+ XUT = struct { XUB, XUA }
+
+ The bounds of the array type XUA (de)reference the XUB * field of a
+ PLACEHOLDER_EXPR for the fat pointer type XUP, so the array type XUA
+ is to be interpreted in the context of the fat pointer type XUB for
+ debug info purposes. */
case E_Array_Type:
{
@@ -2120,7 +2132,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
- tree gnu_max_size = size_one_node, tem, t;
+ tree gnu_max_size = size_one_node, tem, obj;
Entity_Id gnat_index;
int index;
tree comp_type;
@@ -2195,7 +2207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
TREE_TYPE (tem) = ptr_type_node;
TREE_TYPE (DECL_CHAIN (tem)) = gnu_ptr_template;
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_fat_type)) = 0;
- for (t = gnu_fat_type; t; t = TYPE_NEXT_VARIANT (t))
+ for (tree t = gnu_fat_type; t; t = TYPE_NEXT_VARIANT (t))
SET_TYPE_UNCONSTRAINED_ARRAY (t, gnu_type);
}
else
@@ -2212,6 +2224,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
}
+ /* If the GNAT encodings are used, give the fat pointer type a name.
+ If this is a packed array, tell the debugger how to interpret the
+ underlying bits by fetching that of the implementation type. But
+ in any case, mark it as artificial so the debugger can skip it. */
+ const Entity_Id gnat_name
+ = (Present (Packed_Array_Impl_Type (gnat_entity))
+ && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ ? Packed_Array_Impl_Type (gnat_entity)
+ : gnat_entity;
+ tree xup_name
+ = (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ ? create_concat_name (gnat_name, "XUP")
+ : gnu_entity_name;
+ create_type_decl (xup_name, gnu_fat_type, true, debug_info_p,
+ gnat_entity);
+
/* Build a reference to the template from a PLACEHOLDER_EXPR that
is the fat pointer. This will be used to access the individual
fields once we build them. */
@@ -2313,6 +2341,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
= chainon (gnu_template_fields, gnu_temp_fields[index]);
finish_record_type (gnu_template_type, gnu_template_fields, 0,
debug_info_p);
+ TYPE_CONTEXT (gnu_template_type) = current_function_decl;
TYPE_READONLY (gnu_template_type) = 1;
/* If Component_Size is not already specified, annotate it with the
@@ -2369,14 +2398,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
if (TYPE_ALIAS_SET_KNOWN_P (gnu_fat_type))
record_component_aliases (gnu_fat_type);
- /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
- corresponding fat pointer. */
- TREE_TYPE (gnu_type) = gnu_fat_type;
- TYPE_POINTER_TO (gnu_type) = gnu_fat_type;
- TYPE_REFERENCE_TO (gnu_type) = gnu_fat_type;
- SET_TYPE_MODE (gnu_type, BLKmode);
- SET_TYPE_ALIGN (gnu_type, TYPE_ALIGN (tem));
-
/* If the maximum size doesn't overflow, use it. */
if (gnu_max_size
&& TREE_CODE (gnu_max_size) == INTEGER_CST
@@ -2384,24 +2405,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size;
+ /* See the above description for the rationale. */
create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
artificial_p, debug_info_p, gnat_entity);
-
- /* If the GNAT encodings are used, give the fat pointer type a name.
- If this is a packed array, tell the debugger how to interpret the
- underlying bits by fetching that of the implementation type. */
- const Entity_Id gnat_name
- = (Present (Packed_Array_Impl_Type (gnat_entity))
- && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
- ? Packed_Array_Impl_Type (gnat_entity)
- : gnat_entity;
-
- tree xup_name
- = (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
- ? get_entity_name (gnat_name)
- : create_concat_name (gnat_name, "XUP");
- create_type_decl (xup_name, gnu_fat_type, artificial_p, debug_info_p,
- gnat_entity);
+ TYPE_CONTEXT (tem) = gnu_fat_type;
+ TYPE_CONTEXT (TYPE_POINTER_TO (tem)) = gnu_fat_type;
/* Create the type to be designated by thin pointers: a record type for
the array and its template. We used to shift the fields to have the
@@ -2412,14 +2420,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
don't have to name them as a GNAT encoding, except if specifically
asked to. */
tree xut_name
- = (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
- ? get_entity_name (gnat_name)
- : create_concat_name (gnat_name, "XUT");
- tem = build_unc_object_type (gnu_template_type, tem, xut_name,
+ = (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ ? create_concat_name (gnat_name, "XUT")
+ : gnu_entity_name;
+ obj = build_unc_object_type (gnu_template_type, tem, xut_name,
debug_info_p);
- SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
- TYPE_OBJECT_RECORD_TYPE (gnu_type) = tem;
+ SET_TYPE_UNCONSTRAINED_ARRAY (obj, gnu_type);
+ TYPE_OBJECT_RECORD_TYPE (gnu_type) = obj;
+
+ /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
+ corresponding fat pointer. */
+ TREE_TYPE (gnu_type) = gnu_fat_type;
+ TYPE_POINTER_TO (gnu_type) = gnu_fat_type;
+ TYPE_REFERENCE_TO (gnu_type) = gnu_fat_type;
+ SET_TYPE_MODE (gnu_type, BLKmode);
+ SET_TYPE_ALIGN (gnu_type, TYPE_ALIGN (tem));
}
break;
@@ -778,7 +778,7 @@ gnat_get_array_descr_info (const_tree const_type,
{
tree type = const_cast<tree> (const_type);
tree first_dimen, dimen;
- bool is_packed_array, is_array, is_fat_ptr;
+ bool is_packed_array, is_array;
int i;
/* Temporaries created in the first pass and used in the second one for thin
@@ -807,45 +807,16 @@ gnat_get_array_descr_info (const_tree const_type,
&& TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
{
is_array = true;
- is_fat_ptr = false;
first_dimen = type;
- info->data_location = NULL_TREE;
}
- else if (TYPE_IS_FAT_POINTER_P (type)
- && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
- {
- tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type);
-
- /* This will be our base object address. */
- tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
-
- /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF
- node. */
- tree ua_val
- = maybe_unconstrained_array (build_unary_op (INDIRECT_REF,
- ua_type,
- placeholder_expr));
-
- is_array = false;
- is_fat_ptr = true;
- first_dimen = TREE_TYPE (ua_val);
-
- /* Get the *address* of the array, not the array itself. */
- info->data_location = TREE_OPERAND (ua_val, 0);
- }
-
- /* Unlike fat pointers (which appear for unconstrained arrays passed in
- argument), thin pointers are used only for array access types, so we want
- them to appear in the debug info as pointers to an array type. That's why
- we match only the RECORD_TYPE here instead of the POINTER_TYPE with the
- TYPE_IS_THIN_POINTER_P predicate. */
+ /* As well as array types embedded in a record type with their bounds. */
else if (TREE_CODE (type) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (type)
&& gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
/* This will be our base object address. Note that we assume that
- pointers to these will actually point to the array field (thin
+ pointers to this will actually point to the array field (thin
pointers are shifted). */
tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
tree placeholder_addr
@@ -856,7 +827,7 @@ gnat_get_array_descr_info (const_tree const_type,
tree array_field = DECL_CHAIN (bounds_field);
tree array_type = TREE_TYPE (array_field);
- /* Shift the thin pointer address to get the address of the template. */
+ /* Shift back the address to get the address of the template. */
tree shift_amount
= fold_build1 (NEGATE_EXPR, sizetype, byte_position (array_field));
tree template_addr
@@ -865,18 +836,12 @@ gnat_get_array_descr_info (const_tree const_type,
template_addr
= fold_convert (TYPE_POINTER_TO (bounds_type), template_addr);
+ thinptr_template_expr
+ = build_unary_op (INDIRECT_REF, NULL_TREE, template_addr);
+ thinptr_bound_field = TYPE_FIELDS (bounds_type);
+
is_array = false;
- is_fat_ptr = false;
first_dimen = array_type;
-
- /* The thin pointer is already the pointer to the array data, so there's
- no need for a specific "data location" expression. */
- info->data_location = NULL_TREE;
-
- thinptr_template_expr = build_unary_op (INDIRECT_REF,
- bounds_type,
- template_addr);
- thinptr_bound_field = TYPE_FIELDS (bounds_type);
}
else
@@ -932,7 +897,7 @@ gnat_get_array_descr_info (const_tree const_type,
/* We are interested in the stored bounds for the debug info. */
tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen));
- if (is_array || is_fat_ptr)
+ if (is_array)
{
/* GDB does not handle very well the self-referencial bound
expressions we are able to generate here for XUA types (they are
@@ -983,6 +948,7 @@ gnat_get_array_descr_info (const_tree const_type,
/* These are Fortran-specific fields. They make no sense here. */
info->allocated = NULL_TREE;
info->associated = NULL_TREE;
+ info->data_location = NULL_TREE;
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
@@ -891,6 +891,9 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
their GNAT encodings. */
if (TREE_CODE (t) == ARRAY_TYPE && !TYPE_NAME (t))
TYPE_NAME (t) = DECL_NAME (decl);
+ /* Remark the canonical fat pointer type as artificial. */
+ if (TYPE_IS_FAT_POINTER_P (t))
+ TYPE_ARTIFICIAL (t) = 1;
t = NULL_TREE;
}
else if (TYPE_NAME (t)
@@ -4167,7 +4170,6 @@ tree
build_unc_object_type (tree template_type, tree object_type, tree name,
bool debug_info_p)
{
- tree decl;
tree type = make_node (RECORD_TYPE);
tree template_field
= create_field_decl (get_identifier ("BOUNDS"), template_type, type,
@@ -4183,12 +4185,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name,
/* Declare it now since it will never be declared otherwise. This is
necessary to ensure that its subtrees are properly marked. */
- decl = create_type_decl (name, type, true, debug_info_p, Empty);
-
- /* template_type will not be used elsewhere than here, so to keep the debug
- info clean and in order to avoid scoping issues, make decl its
- context. */
- gnat_set_type_context (template_type, decl);
+ create_type_decl (name, type, true, debug_info_p, Empty);
return type;
}