static tree gnat_to_gnu_subprog_type (Entity_Id, bool, bool, tree *);
static int adjust_packed (tree, tree, int);
static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
+static tree get_extended_unconstrained_array (Entity_Id, tree);
static enum inline_status_t inline_status_for_subprog (Entity_Id);
static Entity_Id Gigi_Cloned_Subtype (Entity_Id);
static tree gnu_ext_name_for_subprog (Entity_Id, tree);
initial value (in GCC tree form). This is optional for a variable. For
a renamed entity, GNU_EXPR gives the object being renamed.
+ If GNAT_ENTITY is an array type and GNU_EXPR is NULL_TREE, a GCC tree for a
+ regular fat pointer will be generated. However, if GNU_EXPR is not
+ NULL_TREE, it's an existing GCC tree for the fat pointer, and a GCC tree for
+ the extended pointer will be created instead. The caller must clear the
+ association between GNAT_ENTITY and GNU_EXPR before calling
+ gnat_to_gnu_entity with a non-NULL GNU_EXPR and restore it after the call.
+
DEFINITION is true if this call is intended for a definition. This is used
for separate compilation where it is necessary to know whether an external
declaration or a definition must be created if the GCC equivalent was not
must be specified unless it was specified by the programmer. Exceptions
are for access-to-protected-subprogram types and all access subtypes, as
another GNAT type is used to lay out the GCC type for them, as well as
- access-to-subprogram types if front-end unnesting is enabled. */
+ access-to-subprogram types if front-end unnesting is enabled, and also
+ extended access types. */
gcc_assert (!is_type
|| Known_Esize (gnat_entity)
|| Has_Size_Clause (gnat_entity)
|| kind == E_Anonymous_Access_Subprogram_Type)
&& Unnest_Subprogram_Mode)
|| kind == E_Access_Subtype
+ || Is_Extended_Access_Type (gnat_entity)
|| type_annotate_only)));
/* The RM size must be specified for all discrete and fixed-point types. */
initialize it to NULL, unless the object is declared imported as
per RM B.1(24). */
if (definition
- && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type))
+ && (POINTER_TYPE_P (gnu_type)
+ || TYPE_IS_FAT_POINTER_P (gnu_type)
+ || TYPE_IS_EXTENDED_POINTER_P (gnu_type))
&& !gnu_expr
&& !Is_Imported (gnat_entity))
gnu_expr = null_pointer_node;
have are pointers to that type. In addition to the type node itself,
4 other types associated with it are built in the process:
- 1. the array type (suffix XUA) containing the actual data,
+ 1. the array type (suffix XUA for fat pointer, XUAEA for extended
+ access) containing the actual data,
- 2. the template type (suffix XUB) containing the bounds,
+ 2. the template type (suffix XUB for fat pointer, XUBEA for extended
+ access) containing 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 }
+ or the extended access type (suffix XUPEA) representing a pointer
+ or a reference to the unconstrained array type:
+ XUPEA = struct { XUAEA *, XUBEA }
+
+ 4. the object record type (suffix XUT for fat pointer, XUTEA for
+ extended access) containing bounds and data:
+ XUT[EA] = struct { XUB[EA], XUA[EA] }
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. */
+ debug info purposes. Likewise for the extended access case. */
case E_Array_Type:
{
const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity);
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
+ const bool extended_access_p = gnu_expr != NULL_TREE;
const int ndim = Number_Dimensions (gnat_entity);
tree gnu_fat_type, gnu_template_type, gnu_ptr_template;
- tree gnu_template_reference, gnu_template_fields;
+ tree gnu_template_reference;
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
- tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
tree gnu_max_size = size_one_node;
tree comp_type, fld, tem, obj;
- Entity_Id gnat_index;
alias_set_type ptr_set = -1;
int index;
better debugging information in DWARF by leveraging the support for
incomplete declarations of "tagged" types in the DWARF back-end. */
gnu_type = get_dummy_type (gnat_entity);
- if (gnu_type && TYPE_POINTER_TO (gnu_type))
+ if (gnu_type && TYPE_POINTER_TO (gnu_type) && !extended_access_p)
{
gnu_fat_type = TYPE_MAIN_VARIANT (TYPE_POINTER_TO (gnu_type));
TYPE_NAME (gnu_fat_type) = NULL_TREE;
DECL_CHAIN (TYPE_FIELDS (TYPE_POINTER_TO (gnu_type)))
= copy_node (DECL_CHAIN (TYPE_FIELDS (gnu_fat_type)));
}
+
+ /* We complete an existing dummy for extended access, but we haven't
+ created a specific tree yet for the array type. The extended access
+ type is stored directly in the original unconstrained array type,
+ where we will store the new array type later. */
+ else if (gnu_type
+ && TYPE_DUMMY_EXT_POINTER_TO (gnu_type)
+ && extended_access_p)
+ {
+ gnu_ptr_template = NULL_TREE;
+ tree gnu_ext_acc_type = TYPE_DUMMY_EXT_POINTER_TO (gnu_type);
+ gnu_fat_type = TYPE_MAIN_VARIANT (gnu_ext_acc_type);
+ TYPE_NAME (gnu_fat_type) = NULL_TREE;
+
+ /* The dummy types has a XUBEA that was only used to get the size of
+ the extended pointer. We now drop this type and use the XUB type
+ from the regular fat pointer instead. */
+ gnu_template_type
+ = TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr)))));
+
+ DECL_CHAIN (TYPE_FIELDS (gnu_fat_type))
+ = create_field_decl (get_identifier ("BOUNDS"),
+ gnu_template_type, gnu_fat_type,
+ NULL_TREE, NULL_TREE, 0, 1);
+ }
+
else
{
gnu_fat_type = make_node (RECORD_TYPE);
- gnu_template_type = make_node (RECORD_TYPE);
+
+ if (extended_access_p)
+ gnu_template_type
+ = TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr)))));
+ else
+ gnu_template_type = make_node (RECORD_TYPE);
+
gnu_ptr_template = build_pointer_type (gnu_template_type);
}
Var are also built later with the fields of the final type, the
aliasing machinery may consider that the accesses are distinct
if the FIELD_DECLs are distinct as objects. */
- if (COMPLETE_TYPE_P (gnu_fat_type))
+ if (COMPLETE_TYPE_P (gnu_fat_type) && !extended_access_p)
{
fld = TYPE_FIELDS (gnu_fat_type);
if (TYPE_ALIAS_SET_KNOWN_P (TYPE_CANONICAL (TREE_TYPE (fld))))
for (tree t = gnu_fat_type; t; t = TYPE_NEXT_VARIANT (t))
SET_TYPE_UNCONSTRAINED_ARRAY (t, gnu_type);
}
+
+ else if (COMPLETE_TYPE_P (gnu_fat_type) && extended_access_p)
+ {
+ fld = TYPE_FIELDS (gnu_fat_type);
+ if (TYPE_ALIAS_SET_KNOWN_P (TYPE_CANONICAL (TREE_TYPE (fld))))
+ ptr_set = TYPE_ALIAS_SET (TYPE_CANONICAL (TREE_TYPE (fld)));
+ TREE_TYPE (fld) = ptr_type_node;
+ /* For extended access, we leave the BOUNDS field alone. */
+ TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_fat_type)) = 0;
+ for (tree t = gnu_fat_type; t; t = TYPE_NEXT_VARIANT (t))
+ SET_TYPE_UNCONSTRAINED_ARRAY (t, gnu_type);
+ }
+
+ else if (extended_access_p)
+ {
+ /* We make the fields addressable for the sake of compatibility
+ with languages for which the regular fields are addressable. */
+ fld
+ = create_field_decl (get_identifier ("P_ARRAY"),
+ ptr_type_node, gnu_fat_type,
+ NULL_TREE, NULL_TREE, 0, 1);
+ /* At this step, gnu_template_type is an empty RECORD to be
+ be populated later. */
+ DECL_CHAIN (fld)
+ = create_field_decl (get_identifier ("BOUNDS"),
+ gnu_template_type, gnu_fat_type,
+ NULL_TREE, NULL_TREE, 0, 1);
+ /* Too early to finish the record, but set the fields so that
+ they are available through the type. */
+ TYPE_FIELDS (gnu_fat_type) = fld;
+ SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
+ }
+
else
{
/* We make the fields addressable for the sake of compatibility
: gnat_entity;
tree xup_name
= gnat_encodings == DWARF_GNAT_ENCODINGS_ALL
- ? create_concat_name (gnat_name, "XUP")
+ ? create_concat_name (gnat_name,
+ extended_access_p ? "XUPEA" : "XUP")
: gnu_entity_name;
create_type_decl (xup_name, gnu_fat_type, true, debug_info_p,
gnat_entity, false);
/* 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. */
- tem = build3 (COMPONENT_REF, gnu_ptr_template,
- build0 (PLACEHOLDER_EXPR, gnu_fat_type),
- DECL_CHAIN (fld), NULL_TREE);
- gnu_template_reference
- = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
- TREE_READONLY (gnu_template_reference) = 1;
- TREE_THIS_NOTRAP (gnu_template_reference) = 1;
-
- /* Now create the GCC type for each index and add the fields for that
- index to the template. */
- for (index = (convention_fortran_p ? ndim - 1 : 0),
- gnat_index = First_Index (gnat_entity);
- IN_RANGE (index, 0, ndim - 1);
- index += (convention_fortran_p ? - 1 : 1),
- gnat_index = Next_Index (gnat_index))
+ is the extended/fat pointer. This will be used to access the
+ individual fields once we build them. */
+ if (extended_access_p)
{
- const Entity_Id gnat_index_type = Etype (gnat_index);
- const bool is_flb
- = Is_Fixed_Lower_Bound_Index_Subtype (gnat_index_type);
- tree gnu_index_type = get_unpadded_type (gnat_index_type);
- tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
- tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
- tree gnu_index_base_type = get_base_type (gnu_index_type);
- tree gnu_lb_field, gnu_hb_field;
- tree gnu_min, gnu_max, gnu_high;
- char field_name[16];
-
- /* Update the maximum size of the array in elements. */
- if (gnu_max_size)
- gnu_max_size
- = update_n_elem (gnu_max_size, gnu_orig_min, gnu_orig_max);
-
- /* Now build the self-referential bounds of the index type. */
- gnu_index_type = maybe_character_type (gnu_index_type);
- gnu_index_base_type = maybe_character_type (gnu_index_base_type);
-
- /* Make the FIELD_DECLs for the low and high bounds of this
- type and then make extractions of these fields from the
- template. */
- sprintf (field_name, "LB%d", index);
- gnu_lb_field = create_field_decl (get_identifier (field_name),
- gnu_index_type,
- gnu_template_type, NULL_TREE,
- NULL_TREE, 0, 0);
- /* Mark the field specifically for INSTANTIATE_LOAD_IN_EXPR. */
- DECL_DISCRIMINANT_NUMBER (gnu_lb_field) = integer_minus_one_node;
- Sloc_to_locus (Sloc (gnat_entity),
- &DECL_SOURCE_LOCATION (gnu_lb_field));
-
- field_name[0] = 'U';
- gnu_hb_field = create_field_decl (get_identifier (field_name),
- gnu_index_type,
- gnu_template_type, NULL_TREE,
- NULL_TREE, 0, 0);
- /* Mark the field specifically for INSTANTIATE_LOAD_IN_EXPR. */
- DECL_DISCRIMINANT_NUMBER (gnu_hb_field) = integer_minus_one_node;
- Sloc_to_locus (Sloc (gnat_entity),
- &DECL_SOURCE_LOCATION (gnu_hb_field));
-
- gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_field);
-
- /* We can't use build_component_ref here since the template type
- isn't complete yet. */
- if (!is_flb)
- {
- gnu_orig_min = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field),
- gnu_template_reference, gnu_lb_field,
- NULL_TREE);
- TREE_READONLY (gnu_orig_min) = 1;
- }
-
- gnu_orig_max = build3 (COMPONENT_REF, TREE_TYPE (gnu_hb_field),
- gnu_template_reference, gnu_hb_field,
- NULL_TREE);
- TREE_READONLY (gnu_orig_max) = 1;
-
- gnu_min = convert (sizetype, gnu_orig_min);
- gnu_max = convert (sizetype, gnu_orig_max);
+ /* Extended pointers reference the template directly through the
+ BOUNDS field, which is the second field. */
+ gnu_template_reference
+ = build3 (COMPONENT_REF, gnu_template_type,
+ build0 (PLACEHOLDER_EXPR, gnu_fat_type),
+ DECL_CHAIN (fld), NULL_TREE);
+ TREE_READONLY (gnu_template_reference) = 1;
+ }
+ else
+ {
+ /* Fat pointers reference the template indirectly through the
+ P_BOUNDS field, which is the second field. */
+ tem = build3 (COMPONENT_REF, gnu_ptr_template,
+ build0 (PLACEHOLDER_EXPR, gnu_fat_type),
+ DECL_CHAIN (fld), NULL_TREE);
+ gnu_template_reference
+ = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
+ TREE_READONLY (gnu_template_reference) = 1;
+ TREE_THIS_NOTRAP (gnu_template_reference) = 1;
+ }
- /* Compute the size of this dimension. See the E_Array_Subtype
- case below for the rationale. */
- if (is_flb
- && Nkind (gnat_index) == N_Subtype_Indication
- && flb_cannot_be_superflat (gnat_index))
- gnu_high = gnu_max;
+ if (!extended_access_p)
+ {
+ /* Build the template type. */
+ TYPE_NAME (gnu_template_type)
+ = create_concat_name (gnat_entity, "XUB");
+ }
- else
- gnu_high
- = build3 (COND_EXPR, sizetype,
- build2 (GE_EXPR, boolean_type_node,
- gnu_orig_max, gnu_orig_min),
- gnu_max,
- TREE_CODE (gnu_min) == INTEGER_CST
- ? int_const_binop (MINUS_EXPR, gnu_min, size_one_node)
- : size_binop (MINUS_EXPR, gnu_min, size_one_node));
-
- /* Make a range type with the new range in the Ada base type.
- Then make an index type with the size range in sizetype. */
- gnu_index_types[index]
- = create_index_type (gnu_min, gnu_high,
- create_range_type (gnu_index_base_type,
- gnu_orig_min,
- gnu_orig_max),
- gnat_entity);
+ build_template_type (gnat_entity, gnu_template_type,
+ gnu_template_reference, gnu_index_types,
+ gnu_max_size, debug_info_p);
- TYPE_NAME (gnu_index_types[index])
- = create_concat_name (gnat_entity, field_name);
- }
+ if (!extended_access_p)
+ TYPE_CONTEXT (gnu_template_type) = gnu_fat_type;
- /* Install all the fields into the template. */
- TYPE_NAME (gnu_template_type)
- = create_concat_name (gnat_entity, "XUB");
- TYPE_NAMELESS (gnu_template_type)
- = gnat_encodings != DWARF_GNAT_ENCODINGS_ALL;
- gnu_template_fields = NULL_TREE;
- for (index = 0; index < ndim; index++)
- gnu_template_fields
- = 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) = gnu_fat_type;
+ /* Now that the template type has been created, the record type for
+ extended access can be finished. */
+ if (extended_access_p)
+ finish_extended_pointer_type (gnu_fat_type, fld);
/* If Component_Size is not already specified, annotate it with the
size of the component. */
TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size;
/* See the above description for the rationale. */
+ tree xua_name
+ = create_concat_name (gnat_entity,
+ extended_access_p ? "XUAEA" : "XUA");
tree gnu_tmp_decl
- = create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
- true, debug_info_p, gnat_entity);
+ = create_type_decl (xua_name, tem, true, debug_info_p, gnat_entity);
TYPE_CONTEXT (tem) = gnu_fat_type;
TYPE_CONTEXT (TYPE_POINTER_TO (tem)) = gnu_fat_type;
If the GNAT encodings are used, give it a name. */
tree xut_name
= (gnat_encodings == DWARF_GNAT_ENCODINGS_ALL)
- ? create_concat_name (gnat_name, "XUT")
+ ? create_concat_name (gnat_name,
+ extended_access_p ? "XUTEA" : "XUT")
: gnu_entity_name;
obj = build_unc_object_type (gnu_template_type, tem, xut_name,
artificial_p, debug_info_p);
/* If this is a packed type implemented specially, then process the
implementation type so it is elaborated in the proper scope. */
- if (Present (PAT))
+ if (Present (PAT) && !extended_access_p)
{
/* Save the XUA type as our equivalent temporarily for the call
to gnat_to_gnu_type on the OAT below. */
}
/* Access-to-unconstrained-array types need a special treatment. */
- if (Is_Array_Type (gnat_desig_rep) && !Is_Constrained (gnat_desig_rep))
+ if (Is_Array_Type (gnat_desig_rep)
+ && !Is_Constrained (gnat_desig_rep)
+ && !Is_Extended_Access_Type (gnat_entity))
{
/* If the processing above got something that has a pointer, then
we are done. This could have happened either because the type
gnu_type = TYPE_POINTER_TO (gnu_desig_type);
}
+ else if (Is_Array_Type (gnat_desig_rep)
+ && !Is_Constrained (gnat_desig_rep)
+ && Is_Extended_Access_Type (gnat_entity))
+ {
+ if (TYPE_IS_DUMMY_P (gnu_desig_type))
+ gnu_type
+ = build_dummy_unc_pointer_types_ext (gnat_desig_rep,
+ gnu_desig_type);
+ else
+ {
+ tree gnu_extended_type
+ = get_extended_unconstrained_array (gnat_desig_rep,
+ gnu_desig_type);
+
+ /* We should not get a dummy type. */
+ gnu_type = TYPE_POINTER_TO (gnu_extended_type);
+ gcc_assert (gnu_type);
+ }
+ }
+
/* If we haven't done it yet, build the pointer type the usual way. */
else if (!gnu_type)
{
if (gnu_size)
size = gnu_size;
else if (RECORD_OR_UNION_TYPE_P (gnu_type)
- && !TYPE_FAT_POINTER_P (gnu_type))
+ && !TYPE_FAT_POINTER_P (gnu_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_type))
size = rm_size (gnu_type);
else
size = TYPE_SIZE (gnu_type);
return type;
}
+/* Similar, but GNAT_ENTITY is assumed to refer to a GNAT type. Return
+ the extended version of the GCC type corresponding to that entity. */
+
+tree
+get_unpadded_extended_type (Entity_Id gnat_entity)
+{
+ tree type = gnat_to_gnu_type (gnat_entity);
+
+ tree extended_type = get_extended_unconstrained_array (gnat_entity, type);
+
+ if (TYPE_IS_PADDING_P (extended_type))
+ extended_type = TREE_TYPE (TYPE_FIELDS (extended_type));
+
+ return extended_type;
+}
+
/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
a C++ imported method or equivalent.
return false;
}
+/* Get the UNCONSTRAINED_ARRAY_TYPE tree used for extended access handling,
+ for the unconstrained array type GNAT_ENTITY.
+
+ GNU_TYPE is the UNCONSTRAINED_ARRAY_TYPE tree used for the regular
+ fat/thin pointers. */
+
+static tree
+get_extended_unconstrained_array (Entity_Id gnat_entity, tree gnu_type)
+{
+ gcc_assert (Is_Array_Type (gnat_entity)
+ && TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE);
+
+ tree gnu_extended_type = TYPE_EXTENDED_UNCONSTRAINED_ARRAY (gnu_type);
+
+ /* Building the extended type is achieved by translating the array type
+ a second time using a special processing. */
+ if (!gnu_extended_type)
+ {
+ /* To have gnat_to_gnu_entity trigger the special processing for extended
+ access types, we pass GNU_TYPE as second parameter, we backup the
+ existing association for GNAT_ENTITY and clear it before the call. */
+ tree gnu_decl = get_gnu_tree (gnat_entity);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
+
+ gnu_extended_type
+ = TREE_TYPE (gnat_to_gnu_entity (gnat_entity, gnu_type, false));
+ gcc_assert (gnu_extended_type);
+ SET_TYPE_EXTENDED_UNCONSTRAINED_ARRAY (gnu_type, gnu_extended_type);
+
+ /* And finally, we restore the original association for GNAT_ENTITY. */
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ }
+
+ return gnu_extended_type;
+}
+
/* Return the inlining status of the GNAT subprogram SUBPROG. */
static enum inline_status_t
&& !Strict_Alignment (gnat_type)
&& RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_type)
&& tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
{
tree gnu_packable_type = make_packable_type (gnu_type, false, max_align);
}
}
+/* Build the template type GNU_TEMPLATE_TYPE for the array type GNAT_ENTITY.
+ GNU_TEMPLATE_REFERENCE is an expression to access the template value from
+ the pointer type. If GNU_INDEX_TYPES is not null, it's an array where the
+ index types whose bounds are the values of the template are to be stored.
+ If GNU_MAX_SIZE is not NULL_TREE, it's a tree where the maximum size of
+ the array type is computed. DEBUG_INFO_P is true if debug info needs to
+ be output for this type. */
+
+void
+build_template_type (Entity_Id gnat_entity, tree gnu_template_type,
+ tree gnu_template_reference,
+ tree *gnu_index_types, tree &gnu_max_size,
+ bool debug_info_p)
+{
+ const bool convention_fortran_p
+ = (Convention (gnat_entity) == Convention_Fortran);
+ const int ndim = Number_Dimensions (gnat_entity);
+ tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
+ Entity_Id gnat_index;
+ int index;
+
+ tree template_fields = TYPE_FIELDS (gnu_template_type);
+ const bool template_exists_p = template_fields != NULL_TREE;
+
+ /* Now create the GCC type for each index and add the fields for that
+ index to the template. */
+ for (index = (convention_fortran_p ? ndim - 1 : 0),
+ gnat_index = First_Index (gnat_entity);
+ IN_RANGE (index, 0, ndim - 1);
+ index += (convention_fortran_p ? - 1 : 1),
+ gnat_index = Next_Index (gnat_index))
+ {
+ const Entity_Id gnat_index_type = Etype (gnat_index);
+ const bool is_flb = Is_Fixed_Lower_Bound_Index_Subtype (gnat_index_type);
+ tree gnu_index_type = get_unpadded_type (gnat_index_type);
+ tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
+ tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
+ tree gnu_index_base_type = get_base_type (gnu_index_type);
+ tree gnu_lb_field, gnu_hb_field;
+ tree gnu_min, gnu_max, gnu_high;
+ char field_name[16];
+
+ /* Update the maximum size of the array in elements. */
+ if (gnu_max_size)
+ gnu_max_size
+ = update_n_elem (gnu_max_size, gnu_orig_min, gnu_orig_max);
+
+ /* Now build the self-referential bounds of the index type. */
+ gnu_index_type = maybe_character_type (gnu_index_type);
+ gnu_index_base_type = maybe_character_type (gnu_index_base_type);
+
+ if (template_fields != NULL_TREE)
+ {
+ gnu_lb_field = template_fields;
+ template_fields = DECL_CHAIN (template_fields);
+ gnu_hb_field = template_fields;
+ template_fields = DECL_CHAIN (template_fields);
+ }
+ else
+ {
+ /* Make the FIELD_DECLs for the low and high bounds of this
+ type and then make extractions of these fields from the
+ template. */
+ sprintf (field_name, "LB%d", index);
+ gnu_lb_field = create_field_decl (get_identifier (field_name),
+ gnu_index_type,
+ gnu_template_type, NULL_TREE,
+ NULL_TREE, 0, 0);
+ /* Mark the field specifically for INSTANTIATE_LOAD_IN_EXPR. */
+ DECL_DISCRIMINANT_NUMBER (gnu_lb_field) = integer_minus_one_node;
+ Sloc_to_locus (Sloc (gnat_entity), &DECL_SOURCE_LOCATION (gnu_lb_field));
+
+ field_name[0] = 'U';
+ gnu_hb_field = create_field_decl (get_identifier (field_name),
+ gnu_index_type,
+ gnu_template_type, NULL_TREE,
+ NULL_TREE, 0, 0);
+ /* Mark the field specifically for INSTANTIATE_LOAD_IN_EXPR. */
+ DECL_DISCRIMINANT_NUMBER (gnu_hb_field) = integer_minus_one_node;
+ Sloc_to_locus (Sloc (gnat_entity), &DECL_SOURCE_LOCATION (gnu_hb_field));
+
+ gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_field);
+ }
+
+ if (gnu_index_types)
+ {
+ /* We can't use build_component_ref here since the template type
+ isn't complete yet. */
+ if (!is_flb)
+ {
+ gnu_orig_min
+ = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field),
+ gnu_template_reference, gnu_lb_field,
+ NULL_TREE);
+ TREE_READONLY (gnu_orig_min) = 1;
+ }
+
+ gnu_orig_max = build3 (COMPONENT_REF, TREE_TYPE (gnu_hb_field),
+ gnu_template_reference, gnu_hb_field,
+ NULL_TREE);
+ TREE_READONLY (gnu_orig_max) = 1;
+
+ gnu_min = convert (sizetype, gnu_orig_min);
+ gnu_max = convert (sizetype, gnu_orig_max);
+
+ /* Compute the size of this dimension. See the E_Array_Subtype
+ case of gnat_to_gnu_entity for the rationale. */
+ if (is_flb
+ && Nkind (gnat_index) == N_Subtype_Indication
+ && flb_cannot_be_superflat (gnat_index))
+ gnu_high = gnu_max;
+
+ else
+ gnu_high
+ = build3 (COND_EXPR, sizetype,
+ build2 (GE_EXPR, boolean_type_node,
+ gnu_orig_max, gnu_orig_min),
+ gnu_max,
+ TREE_CODE (gnu_min) == INTEGER_CST
+ ? int_const_binop (MINUS_EXPR, gnu_min, size_one_node)
+ : size_binop (MINUS_EXPR, gnu_min, size_one_node));
+
+ /* Make a range type with the new range in the Ada base type.
+ Then make an index type with the size range in sizetype. */
+ gnu_index_types[index]
+ = create_index_type (gnu_min, gnu_high,
+ create_range_type (gnu_index_base_type,
+ gnu_orig_min,
+ gnu_orig_max),
+ gnat_entity);
+
+ TYPE_NAME (gnu_index_types[index])
+ = create_concat_name (gnat_entity, field_name);
+ }
+ }
+
+ if (!template_exists_p)
+ {
+ TYPE_NAMELESS (gnu_template_type)
+ = gnat_encodings != DWARF_GNAT_ENCODINGS_ALL;
+
+ tree gnu_template_fields = NULL_TREE;
+ for (index = 0; index < ndim; index++)
+ gnu_template_fields
+ = chainon (gnu_template_fields, gnu_temp_fields[index]);
+ finish_record_type (gnu_template_type, gnu_template_fields, 0, debug_info_p);
+ }
+}
+
/* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
NAME, ARGS and ERROR_POINT. */
if (!needs_strict_alignment
&& RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_field_type)
&& tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type))
&& (packed == 1
|| is_bitfield
if (!needs_strict_alignment
&& RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_field_type)
&& TYPE_MODE (gnu_field_type) == BLKmode
&& is_bitfield)
gnu_field_type = make_packable_type (gnu_field_type, true, 1);
/* If this is an access type or a fat pointer, the minimum size is that given
by the default pointer mode. */
- if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type))
+ if (TREE_CODE (gnu_type) == POINTER_TYPE
+ || TYPE_IS_FAT_POINTER_P (gnu_type)
+ || TYPE_IS_EXTENDED_POINTER_P (gnu_type))
old_size = bitsize_int (GET_MODE_BITSIZE (ptr_mode));
/* Issue an error either if the default size of the object isn't a constant
/* ...or the Ada size for record and union types. */
else if (RECORD_OR_UNION_TYPE_P (gnu_type)
- && !TYPE_FAT_POINTER_P (gnu_type))
+ && !TYPE_FAT_POINTER_P (gnu_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_type))
SET_TYPE_ADA_SIZE (gnu_type, size);
}
gnu_size = DECL_SIZE (gnu_old_field);
if (RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_field_type)
&& tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type)))
gnu_field_type = make_packable_type (gnu_field_type, true, 0);
}
/* For record or union types, we store the size explicitly. */
if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
+ && !TYPE_EXTENDED_POINTER_P (gnu_type)
&& TYPE_ADA_SIZE (gnu_type))
return TYPE_ADA_SIZE (gnu_type);
static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *);
static tree float_type_for_precision (int, machine_mode);
-static tree convert_to_fat_pointer (tree, tree);
static unsigned int scale_by_factor_of (tree, unsigned int);
/* Linked list used as a queue to defer the initialization of the DECL_CONTEXT
TYPE_OBJECT_RECORD_TYPE (gnu_desig_type) = gnu_object_type;
}
+/* Build dummy extended access types whose designated type is specified by
+ GNAT_DESIG_TYPE/GNU_DESIG_TYPE and attach them to the latter. */
+
+tree
+build_dummy_unc_pointer_types_ext (Entity_Id gnat_desig_type, tree gnu_desig_type)
+{
+ tree gnu_template_type, gnu_array_type, gnu_ptr_array;
+ tree gnu_ext_acc_type = make_node (RECORD_TYPE);
+ tree fields, dummy = NULL_TREE;
+
+ gnu_template_type = make_node (RECORD_TYPE);
+ TYPE_NAME (gnu_template_type) = create_concat_name (gnat_desig_type, "XUBEA");
+ TYPE_DUMMY_P (gnu_template_type) = 1;
+
+ /* This will also set TYPE_POINTER_TO field for the template type, even if
+ we don't need it here. */
+ build_pointer_type (gnu_template_type);
+
+ /* The following call only builds the template record, but other dependent
+ types or other more complex expressions for bounds are NOT created.
+ This allows the size of an extended access to be computed, but it must be
+ completed later. */
+ build_template_type (gnat_desig_type, gnu_template_type, NULL_TREE, NULL,
+ dummy, false);
+
+ TYPE_CONTEXT (gnu_template_type) = gnu_ext_acc_type;
+
+ gnu_array_type = make_node (ENUMERAL_TYPE);
+ TYPE_NAME (gnu_array_type) = create_concat_name (gnat_desig_type, "XUAEA");
+ TYPE_DUMMY_P (gnu_array_type) = 1;
+ gnu_ptr_array = build_pointer_type (gnu_array_type);
+
+ /* Build a stub DECL to trigger the special processing for fat pointer types
+ in gnat_pushdecl. */
+ TYPE_NAME (gnu_ext_acc_type)
+ = create_type_stub_decl (create_concat_name (gnat_desig_type, "XUPEA"),
+ gnu_ext_acc_type);
+ fields = create_field_decl (get_identifier ("P_ARRAY"), gnu_ptr_array,
+ gnu_ext_acc_type, NULL_TREE, NULL_TREE, 0, 1);
+ DECL_CHAIN (fields)
+ = create_field_decl (get_identifier ("BOUNDS"), gnu_template_type,
+ gnu_ext_acc_type, NULL_TREE, NULL_TREE, 0, 1);
+ finish_extended_pointer_type (gnu_ext_acc_type, fields);
+ SET_TYPE_UNCONSTRAINED_ARRAY (gnu_ext_acc_type, gnu_desig_type);
+
+ /* Suppress debug info until after the type is completed. */
+ TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_ext_acc_type)) = 1;
+
+ SET_TYPE_DUMMY_EXT_POINTER_TO (gnu_desig_type, gnu_ext_acc_type);
+
+ return gnu_ext_acc_type;
+}
+
/* Return true if we are in the global binding level. */
bool
}
/* Pointer types aren't named types in the C sense so we need to generate a
- typedef in DWARF for them. Also do that for fat pointer types because,
- even though they are named types in the C sense, they are still the XUP
- types created for the base array type at this point. */
-#define TYPE_IS_POINTER_P(NODE) \
- (TREE_CODE (NODE) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (NODE))
+ typedef in DWARF for them. Also do that for fat and extended pointer types
+ because, even though they are named types in the C sense, they are still
+ the XUP[EA] types created for the base array type at this point. */
+#define TYPE_IS_POINTER_P(NODE) \
+ (TREE_CODE (NODE) == POINTER_TYPE \
+ || TYPE_IS_FAT_POINTER_P (NODE) \
+ || TYPE_IS_EXTENDED_POINTER_P (NODE))
/* For the declaration of a type, set its name either if it isn't already
set or if the previous type name was not derived from a source name.
DECL_ORIGINAL_TYPE (decl) = DECL_ORIGINAL_TYPE (TYPE_NAME (t));
else
DECL_ORIGINAL_TYPE (decl) = t;
- /* Remark the canonical fat pointer type as artificial. */
- if (TYPE_IS_FAT_POINTER_P (t))
+ /* Remark the canonical fat or extended pointer type as artificial. */
+ if (TYPE_IS_FAT_POINTER_P (t) || TYPE_IS_EXTENDED_POINTER_P (t))
TYPE_ARTIFICIAL (t) = 1;
t = NULL_TREE;
}
if (align > 0
&& RECORD_OR_UNION_TYPE_P (type)
&& !TYPE_IS_FAT_POINTER_P (type)
+ && !TYPE_IS_EXTENDED_POINTER_P (type)
&& TYPE_MODE (type) == BLKmode
&& !TYPE_BY_REFERENCE_P (type)
&& TREE_CODE (orig_size) == INTEGER_CST
TYPE_CONTAINS_PLACEHOLDER_INTERNAL (record_type) = 2;
}
+/* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
+ finish constructing the record type as an extended access type. */
+
+void
+finish_extended_pointer_type (tree record_type, tree field_list)
+{
+ /* Show what it really is. */
+ TYPE_EXTENDED_POINTER_P (record_type) = 1;
+
+ /* Do not emit debug info for it since the types of its fields may still be
+ incomplete at this point. */
+ finish_record_type (record_type, field_list, 0, false);
+
+ /* Force type_contains_placeholder_p to return true on it. Although the
+ PLACEHOLDER_EXPRs are referenced only indirectly, this isn't a pointer
+ type but the representation of the unconstrained array. */
+ TYPE_CONTAINS_PLACEHOLDER_INTERNAL (record_type) = 2;
+}
+
/* Clear DECL_BIT_FIELD flag and associated markers on FIELD, which is a field
of aggregate type TYPE. */
if (RECORD_OR_UNION_TYPE_P (type)
&& !TYPE_FAT_POINTER_P (type)
+ && !TYPE_EXTENDED_POINTER_P (type)
&& !TYPE_CONTAINS_TEMPLATE_P (type)
&& TYPE_ADA_SIZE (type))
this_ada_size = TYPE_ADA_SIZE (type);
{
/* Now set any of the values we've just computed that apply. */
if (!TYPE_FAT_POINTER_P (record_type)
+ && !TYPE_EXTENDED_POINTER_P (record_type)
&& !TYPE_CONTAINS_TEMPLATE_P (record_type))
SET_TYPE_ADA_SIZE (record_type, ada_size);
}
return type;
}
-/* Same, taking a thin or fat pointer type instead of a template type. */
+/* Same, taking a pointer type instead of a template type. */
tree
-build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
- tree name, bool debug_info_p)
+build_unc_object_type_from_ptr (tree ptr_type, tree object_type, tree name,
+ bool debug_info_p)
{
tree template_type;
- gcc_assert (TYPE_IS_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
-
- template_type
- = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type)
- ? TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
- : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
+ if (TYPE_IS_EXTENDED_POINTER_P (ptr_type))
+ template_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (ptr_type)));
+ else if (TYPE_IS_FAT_POINTER_P (ptr_type))
+ template_type
+ = TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (ptr_type))));
+ else if (TYPE_IS_THIN_POINTER_P (ptr_type))
+ template_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (ptr_type)));
+ else
+ gcc_unreachable ();
return
build_unc_object_type (template_type, object_type, name, true,
vec<constructor_elt, va_gc> *v;
vec_alloc (v, 2);
+ /* We don't allow conversion from extended to fat pointers. */
+ gcc_assert (!TYPE_IS_EXTENDED_POINTER_P (etype));
+
/* If EXPR is null, make a fat pointer that contains a null pointer to the
array (compare_fat_pointers ensures that this is the full discriminant)
and a valid pointer to the bounds. This latter property is necessary
return gnat_build_constructor (type, v);
}
+/* Convert EXPR, a pointer to a constrained array, into a pointer to an
+ unconstrained one using an extended access. This involves making or
+ finding a template. */
+
+static tree
+convert_to_extended_pointer (tree type, tree expr)
+{
+ tree template_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type)));
+ tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
+ tree etype = TREE_TYPE (expr);
+ tree template_val;
+ vec<constructor_elt, va_gc> *v;
+ vec_alloc (v, 2);
+
+ /* If EXPR is null, make a fat pointer that contains a null pointer to the
+ array (compare_fat_pointers ensures that this is the full discriminant)
+ and a valid pointer to the bounds. This latter property is necessary
+ since the compiler can hoist the load of the bounds done through it. */
+ if (integer_zerop (expr))
+ {
+ tree template_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type)));
+ tree null_bounds, t;
+
+ null_bounds = build_constructor (template_type, NULL);
+ TREE_CONSTANT (null_bounds) = TREE_STATIC (null_bounds) = 1;
+
+ CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
+ fold_convert (p_array_type, null_pointer_node));
+ CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)) , null_bounds);
+ t = build_constructor (type, v);
+ /* Do not set TREE_CONSTANT so as to force T to static memory. */
+ TREE_CONSTANT (t) = 0;
+ TREE_STATIC (t) = 1;
+
+ return t;
+ }
+
+ /* If EXPR is a thin pointer, make template and data from the record. */
+ if (TYPE_IS_THIN_POINTER_P (etype))
+ {
+ tree field = TYPE_FIELDS (TREE_TYPE (etype));
+
+ expr = gnat_protect_expr (expr);
+
+ /* If we have a TYPE_UNCONSTRAINED_ARRAY attached to the RECORD_TYPE,
+ the thin pointer value has been shifted so we shift it back to get
+ the template address. */
+ if (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (etype)))
+ {
+ tree template_addr
+ = fold_convert (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type))), expr);
+ template_val = build_unary_op (INDIRECT_REF, NULL_TREE, template_addr);
+ }
+
+ /* Otherwise we explicitly take the address of the fields. */
+ else
+ {
+ expr = build_unary_op (INDIRECT_REF, NULL_TREE, expr);
+
+ template_val = build_component_ref (expr, field, true);
+
+ expr = build_unary_op (ADDR_EXPR, NULL_TREE,
+ build_component_ref (expr, DECL_CHAIN (field),
+ false));
+ }
+ }
+
+ else if (TYPE_IS_FAT_POINTER_P (etype))
+ template_val
+ = build_unary_op (INDIRECT_REF, NULL_TREE,
+ build_component_ref (expr,
+ DECL_CHAIN (TYPE_FIELDS (etype)),
+ false));
+
+ /* Otherwise, build the constructor for the template. */
+ else
+ template_val = build_template (template_type, TREE_TYPE (etype), expr);
+
+ /* The final result is a constructor for the extended pointer.
+
+ If EXPR is an argument of a foreign convention subprogram, the type it
+ points to is directly the component type. In this case, the expression
+ type may not match the corresponding FIELD_DECL type at this point, so we
+ call "convert" here to fix that up if necessary. This type consistency is
+ required, for instance because it ensures that possible later folding of
+ COMPONENT_REFs against this constructor always yields something of the
+ same type as the initial reference.
+
+ Note that the call to "build_template" above is still fine because it
+ will only refer to the provided TEMPLATE_TYPE in this case. */
+ CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), convert (p_array_type, expr));
+ CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), template_val);
+ return gnat_build_constructor (type, v);
+}
+
/* Create an expression whose value is that of EXPR,
converted to type TYPE. The TREE_TYPE of the value
is always TYPE. This function implements all reasonable
/* Check for converting to a pointer to an unconstrained array. */
if (TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
+ if (TYPE_IS_EXTENDED_POINTER_P (type) && !TYPE_IS_EXTENDED_POINTER_P (etype))
+ return convert_to_extended_pointer (type, expr);
/* If we are converting between two aggregate or vector types that are mere
variants, just make a VIEW_CONVERT_EXPR. Likewise when we are converting
/* If converting fat pointer to normal or thin pointer, get the pointer
to the array and then convert it. */
- if (TYPE_IS_FAT_POINTER_P (etype))
+ if (TYPE_IS_FAT_POINTER_P (etype) || TYPE_IS_EXTENDED_POINTER_P (etype))
expr = build_component_ref (expr, TYPE_FIELDS (etype), false);
return fold (convert_to_pointer (type, expr));
}
/* If EXPR is a constrained array, take its address, convert it to a
- fat pointer, and then dereference it. Likewise if EXPR is a
- record containing both a template and a constrained array.
- Note that a record representing a justified modular type
- always represents a packed constrained array. */
+ fat or extended pointer, and then dereference it. Likewise if
+ EXPR is a record containing both a template and a constrained
+ array. Note that a record representing a justified modular type
+ always represents a packed constrained array. */
if (ecode == ARRAY_TYPE
|| (ecode == INTEGER_TYPE && TYPE_HAS_ACTUAL_BOUNDS_P (etype))
|| (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype))
|| (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)))
- return
- build_unary_op
- (INDIRECT_REF, NULL_TREE,
- convert_to_fat_pointer (TREE_TYPE (type),
- build_unary_op (ADDR_EXPR,
- NULL_TREE, expr)));
+ {
+ if (TYPE_IS_EXTENDED_POINTER_P (TREE_TYPE (type)))
+ return
+ build_unary_op
+ (INDIRECT_REF, NULL_TREE,
+ convert_to_extended_pointer (TREE_TYPE (type),
+ build_unary_op (ADDR_EXPR,
+ NULL_TREE, expr)));
+ else
+ return
+ build_unary_op
+ (INDIRECT_REF, NULL_TREE,
+ convert_to_fat_pointer (TREE_TYPE (type),
+ build_unary_op (ADDR_EXPR,
+ NULL_TREE, expr)));
+ }
/* Do something very similar for converting one unconstrained
array to another. */
projects / thirdparty / gcc.git / commitdiff
