* *
* C Implementation File *
* *
- * Copyright (C) 1992-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#include "ada-tree.h"
#include "gigi.h"
-/* Convention_Stdcall should be processed in a specific way on 32 bits
- Windows targets only. The macro below is a helper to avoid having to
- check for a Windows specific attribute throughout this unit. */
+/* "stdcall" and "thiscall" conventions should be processed in a specific way
+ on 32-bit x86/Windows only. The macros below are helpers to avoid having
+ to check for a Windows specific attribute throughout this unit. */
#if TARGET_DLLIMPORT_DECL_ATTRIBUTES
#ifdef TARGET_64BIT
#define Has_Stdcall_Convention(E) \
(!TARGET_64BIT && Convention (E) == Convention_Stdcall)
+#define Has_Thiscall_Convention(E) \
+ (!TARGET_64BIT && is_cplusplus_method (E))
#else
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
+#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))
#endif
#else
#define Has_Stdcall_Convention(E) 0
+#define Has_Thiscall_Convention(E) 0
#endif
/* Stack realignment is necessary for functions with foreign conventions when
/* The value of the qualifier. */
tree qual;
- /* The record associated with this variant. */
- tree record;
+ /* The type of the variant after transformation. */
+ tree new_type;
} variant_desc;
DEF_VEC_O(variant_desc);
enum attr_type, tree, tree, Node_Id);
static void prepend_attributes (Entity_Id, struct attrib **);
static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
-static bool is_variable_size (tree);
+static bool type_has_variable_size (tree);
static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
unsigned int);
static bool cannot_be_superflat_p (Node_Id);
static bool constructor_address_p (tree);
static void components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
- bool, bool, bool, bool, tree *);
+ bool, bool, bool, bool, bool, tree, tree *);
static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree);
static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
static void check_ok_for_atomic (tree, Entity_Id, bool);
static tree create_field_decl_from (tree, tree, tree, tree, tree,
VEC(subst_pair,heap) *);
+static tree create_rep_part (tree, tree, tree);
static tree get_rep_part (tree);
static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree,
tree, VEC(subst_pair,heap) *);
gnu_size = max_size (TYPE_SIZE (gnu_type), true);
mutable_p = true;
}
+
+ /* If we are at global level and the size isn't constant, call
+ elaborate_expression_1 to make a variable for it rather than
+ calculating it each time. */
+ if (global_bindings_p () && !TREE_CONSTANT (gnu_size))
+ gnu_size = elaborate_expression_1 (gnu_size, gnat_entity,
+ get_identifier ("SIZE"),
+ definition, false);
}
/* If the size is zero byte, make it one byte since some linkers have
&& Is_Array_Type (Etype (gnat_entity))
&& !type_annotate_only)
{
- tree gnu_fat
- = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
+ tree gnu_array
+ = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
gnu_type
- = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
+ = build_unc_object_type_from_ptr (TREE_TYPE (gnu_array),
+ gnu_type,
concat_name (gnu_entity_name,
"UNC"),
debug_info_p);
saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE,
false, false);
+ /* This assertion will fail if the renamed object
+ isn't aligned enough as to make it possible to
+ honor the alignment set on the renaming. */
+ if (align)
+ {
+ unsigned int renamed_align
+ = DECL_P (gnu_decl)
+ ? DECL_ALIGN (gnu_decl)
+ : TYPE_ALIGN (TREE_TYPE (gnu_decl));
+ gcc_assert (renamed_align >= align);
+ }
break;
}
entity is always accessed indirectly through it. */
else
{
+ /* We need to preserve the volatileness of the renamed
+ object through the indirection. */
+ if (TREE_THIS_VOLATILE (gnu_expr)
+ && !TYPE_VOLATILE (gnu_type))
+ gnu_type
+ = build_qualified_type (gnu_type,
+ (TYPE_QUALS (gnu_type)
+ | TYPE_QUAL_VOLATILE));
gnu_type = build_reference_type (gnu_type);
inner_const_flag = TREE_READONLY (gnu_expr);
const_flag = true;
const_flag = true;
}
+ /* If this is an aliased object with an unconstrained nominal subtype,
+ we make its type a thin reference, i.e. the reference counterpart
+ of a thin pointer, so that it points to the array part. This is
+ aimed at making it easier for the debugger to decode the object.
+ Note that we have to do that this late because of the couple of
+ allocation adjustments that might be made just above. */
+ if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+ && Is_Array_Type (Etype (gnat_entity))
+ && !type_annotate_only)
+ {
+ tree gnu_array
+ = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
+
+ /* In case the object with the template has already been allocated
+ just above, we have nothing to do here. */
+ if (!TYPE_IS_THIN_POINTER_P (gnu_type))
+ {
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
+
+ if (definition && !imported_p)
+ {
+ tree gnu_unc_var
+ = create_var_decl (concat_name (gnu_entity_name, "UNC"),
+ NULL_TREE, gnu_type, gnu_expr,
+ const_flag, Is_Public (gnat_entity),
+ false, static_p, NULL, gnat_entity);
+ gnu_expr
+ = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
+ TREE_CONSTANT (gnu_expr) = 1;
+ const_flag = true;
+ }
+ else
+ {
+ gnu_expr = NULL_TREE;
+ const_flag = false;
+ }
+ }
+
+ gnu_type
+ = build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array));
+ }
+
if (const_flag)
gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
| TYPE_QUAL_CONST));
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
const int ndim = Number_Dimensions (gnat_entity);
- tree gnu_template_type = make_node (RECORD_TYPE);
- tree gnu_ptr_template = build_pointer_type (gnu_template_type);
+ tree gnu_template_type;
+ tree gnu_ptr_template;
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, gnu_max_size_unit, tem, t;
Entity_Id gnat_index, gnat_name;
int index;
+ tree comp_type;
+
+ /* Create the type for the component now, as it simplifies breaking
+ type reference loops. */
+ comp_type
+ = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+ if (present_gnu_tree (gnat_entity))
+ {
+ /* As a side effect, the type may have been translated. */
+ maybe_present = true;
+ break;
+ }
/* We complete an existing dummy fat pointer type in place. This both
avoids further complex adjustments in update_pointer_to and yields
TYPE_NAME (gnu_fat_type) = NULL_TREE;
/* Save the contents of the dummy type for update_pointer_to. */
TYPE_POINTER_TO (gnu_type) = copy_type (gnu_fat_type);
+ gnu_ptr_template =
+ TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
+ gnu_template_type = TREE_TYPE (gnu_ptr_template);
}
else
- gnu_fat_type = make_node (RECORD_TYPE);
+ {
+ gnu_fat_type = make_node (RECORD_TYPE);
+ gnu_template_type = make_node (RECORD_TYPE);
+ gnu_ptr_template = build_pointer_type (gnu_template_type);
+ }
/* Make a node for the array. If we are not defining the array
suppress expanding incomplete types. */
debug_info_p);
TYPE_READONLY (gnu_template_type) = 1;
- /* Now make the array of arrays and update the pointer to the array
- in the fat pointer. Note that it is the first field. */
- tem
- = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+ /* Now build the array type. */
/* If Component_Size is not already specified, annotate it with the
size of the component. */
if (Unknown_Component_Size (gnat_entity))
- Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
+ Set_Component_Size (gnat_entity,
+ annotate_value (TYPE_SIZE (comp_type)));
/* Compute the maximum size of the array in units and bits. */
if (gnu_max_size)
{
gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
- TYPE_SIZE_UNIT (tem));
+ TYPE_SIZE_UNIT (comp_type));
gnu_max_size = size_binop (MULT_EXPR,
convert (bitsizetype, gnu_max_size),
- TYPE_SIZE (tem));
+ TYPE_SIZE (comp_type));
}
else
gnu_max_size_unit = NULL_TREE;
/* Now build the array type. */
+ tem = comp_type;
for (index = ndim - 1; index >= 0; index--)
{
tem = build_nonshared_array_type (tem, gnu_index_types[index]);
/* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, false,
- all_rep, is_unchecked_union, debug_info_p,
+ all_rep, is_unchecked_union,
+ !Comes_From_Source (gnat_entity), debug_info_p,
false, OK_To_Reorder_Components (gnat_entity),
- NULL);
+ all_rep ? NULL_TREE : bitsize_zero_node, NULL);
/* If it is passed by reference, force BLKmode to ensure that objects
of this type will always be put in memory. */
else
gnu_unpad_base_type = gnu_base_type;
- /* Look for a REP part in the base type. */
- gnu_rep_part = get_rep_part (gnu_unpad_base_type);
-
/* Look for a variant part in the base type. */
gnu_variant_part = get_variant_part (gnu_unpad_base_type);
{
tree old_variant = v->type;
tree new_variant = make_node (RECORD_TYPE);
+ tree suffix
+ = concat_name (DECL_NAME (gnu_variant_part),
+ IDENTIFIER_POINTER
+ (DECL_NAME (v->field)));
TYPE_NAME (new_variant)
- = DECL_NAME (TYPE_NAME (old_variant));
+ = concat_name (TYPE_NAME (gnu_type),
+ IDENTIFIER_POINTER (suffix));
copy_and_substitute_in_size (new_variant, old_variant,
gnu_subst_list);
- v->record = new_variant;
+ v->new_type = new_variant;
}
}
else
== INTEGER_CST)
{
gnu_size = DECL_SIZE (gnu_old_field);
- if (TREE_CODE (gnu_field_type) == RECORD_TYPE
+ if (RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
&& host_integerp (TYPE_SIZE (gnu_field_type), 1))
gnu_field_type
and put the field either in the new type if there is a
selected variant or in one of the new variants. */
if (gnu_context == gnu_unpad_base_type
- || (gnu_rep_part
+ || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
&& gnu_context == TREE_TYPE (gnu_rep_part)))
gnu_cont_type = gnu_type;
else
t = NULL_TREE;
FOR_EACH_VEC_ELT_REVERSE (variant_desc,
gnu_variant_list, ix, v)
- if (v->type == gnu_context)
+ if (gnu_context == v->type
+ || ((gnu_rep_part = get_rep_part (v->type))
+ && gnu_context == TREE_TYPE (gnu_rep_part)))
{
t = v->type;
break;
if (selected_variant)
gnu_cont_type = gnu_type;
else
- gnu_cont_type = v->record;
+ gnu_cont_type = v->new_type;
}
else
/* The front-end may pass us "ghost" components if
break;
}
- /* If we have not done it yet, build the pointer type the usual way. */
+ /* If we haven't done it yet, build the pointer type the usual way. */
if (!gnu_type)
{
/* Modify the designated type if we are pointing only to constant
return_by_invisi_ref_p = true;
/* Likewise, if the return type is itself By_Reference. */
- else if (TREE_ADDRESSABLE (gnu_return_type))
+ else if (TYPE_IS_BY_REFERENCE_P (gnu_return_type))
return_by_invisi_ref_p = true;
/* If the type is a padded type and the underlying type would not
/* The failure of this assertion will very likely come from an
order of elaboration issue for the type of the parameter. */
gcc_assert (kind == E_Subprogram_Type
- || !TYPE_IS_DUMMY_P (gnu_param_type));
+ || !TYPE_IS_DUMMY_P (gnu_param_type)
+ || type_annotate_only);
if (gnu_param)
{
gnu_return_type = gnu_new_ret_type;
TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
- /* Set a default alignment to speed up accesses. */
+ /* Set a default alignment to speed up accesses. But we
+ shouldn't increase the size of the structure too much,
+ lest it doesn't fit in return registers anymore. */
TYPE_ALIGN (gnu_return_type)
= get_mode_alignment (ptr_mode);
}
= create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, NULL_TREE, NULL_TREE,
0, 0);
- /* Set a minimum alignment to speed up accesses. */
- if (DECL_ALIGN (gnu_field) < TYPE_ALIGN (gnu_return_type))
- DECL_ALIGN (gnu_field) = TYPE_ALIGN (gnu_return_type);
Sloc_to_locus (Sloc (gnat_param),
&DECL_SOURCE_LOCATION (gnu_field));
DECL_CHAIN (gnu_field) = gnu_field_list;
(&attr_list, ATTR_MACHINE_ATTRIBUTE,
get_identifier ("stdcall"), NULL_TREE,
gnat_entity);
+ else if (Has_Thiscall_Convention (gnat_entity))
+ prepend_one_attribute_to
+ (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+ get_identifier ("thiscall"), NULL_TREE,
+ gnat_entity);
/* If we should request stack realignment for a foreign convention
subprogram, do so. Note that this applies to task entry points in
break;
case E_Label:
- gnu_decl = create_label_decl (gnu_entity_name);
+ gnu_decl = create_label_decl (gnu_entity_name, gnat_entity);
break;
case E_Block:
|| Is_Class_Wide_Equivalent_Type (gnat_entity))
TYPE_ALIGN_OK (gnu_type) = 1;
- /* If the type is passed by reference, objects of this type must be
- fully addressable and cannot be copied. */
- if (Is_By_Reference_Type (gnat_entity))
- TREE_ADDRESSABLE (gnu_type) = 1;
+ /* Record whether the type is passed by reference. */
+ if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
+ TYPE_BY_REFERENCE_P (gnu_type) = 1;
/* ??? Don't set the size for a String_Literal since it is either
confirming or we don't handle it properly (if the low bound is
tree size;
/* If a size was specified, take it into account. Otherwise
- use the RM size for records as the type size has already
- been adjusted to the alignment. */
+ use the RM size for records or unions as the type size has
+ already been adjusted to the alignment. */
if (gnu_size)
size = gnu_size;
- else if ((TREE_CODE (gnu_type) == RECORD_TYPE
- || TREE_CODE (gnu_type) == UNION_TYPE
- || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+ else if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type))
size = rm_size (gnu_type);
else
return type;
}
+
+/* Return the DECL associated with the public subprogram GNAT_ENTITY but whose
+ type has been changed to that of the parameterless procedure, except if an
+ alias is already present, in which case it is returned instead. */
+
+tree
+get_minimal_subprog_decl (Entity_Id gnat_entity)
+{
+ tree gnu_entity_name, gnu_ext_name;
+ struct attrib *attr_list = NULL;
+
+ /* See the E_Function/E_Procedure case of gnat_to_gnu_entity for the model
+ of the handling applied here. */
+
+ while (Present (Alias (gnat_entity)))
+ {
+ gnat_entity = Alias (gnat_entity);
+ if (present_gnu_tree (gnat_entity))
+ return get_gnu_tree (gnat_entity);
+ }
+
+ gnu_entity_name = get_entity_name (gnat_entity);
+ gnu_ext_name = create_concat_name (gnat_entity, NULL);
+
+ if (Has_Stdcall_Convention (gnat_entity))
+ prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+ get_identifier ("stdcall"), NULL_TREE,
+ gnat_entity);
+ else if (Has_Thiscall_Convention (gnat_entity))
+ prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+ get_identifier ("thiscall"), NULL_TREE,
+ gnat_entity);
+
+ if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_name)
+ gnu_ext_name = NULL_TREE;
+
+ return
+ create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
+ false, true, true, true, attr_list, gnat_entity);
+}
\f
/* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it.
Every TYPE_DECL generated for a type definition must be passed
}
}
+/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
+ a C++ imported method or equivalent.
+
+ We use the predicate on 32-bit x86/Windows to find out whether we need to
+ use the "thiscall" calling convention for GNAT_ENTITY. This convention is
+ used for C++ methods (functions with METHOD_TYPE) by the back-end. */
+
+bool
+is_cplusplus_method (Entity_Id gnat_entity)
+{
+ if (Convention (gnat_entity) != Convention_CPP)
+ return False;
+
+ /* This is the main case: C++ method imported as a primitive operation. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return True;
+
+ /* A thunk needs to be handled like its associated primitive operation. */
+ if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
+ return True;
+
+ /* C++ classes with no virtual functions can be imported as limited
+ record types, but we need to return true for the constructors. */
+ if (Is_Constructor (gnat_entity))
+ return True;
+
+ /* This is set on the E_Subprogram_Type built for a dispatching call. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
+ return True;
+
+ return False;
+}
+
/* Finalize the processing of From_With_Type incomplete types. */
void
}
gcc_assert (Present (gnat_equiv) || type_annotate_only);
+
return gnat_equiv;
}
&& !Is_Bit_Packed_Array (gnat_array)
&& !Has_Aliased_Components (gnat_array)
&& !Strict_Alignment (gnat_type)
- && TREE_CODE (gnu_type) == RECORD_TYPE
+ && RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
&& host_integerp (TYPE_SIZE (gnu_type), 1))
gnu_type = make_packable_type (gnu_type, false);
|| (!foreign
&& default_pass_by_ref (gnu_param_type)))))
{
+ /* We take advantage of 6.2(12) by considering that references built for
+ parameters whose type isn't by-ref and for which the mechanism hasn't
+ been forced to by-ref are restrict-qualified in the C sense. */
+ bool restrict_p
+ = !TYPE_IS_BY_REFERENCE_P (gnu_param_type) && mech != By_Reference;
gnu_param_type = build_reference_type (gnu_param_type);
+ if (restrict_p)
+ gnu_param_type
+ = build_qualified_type (gnu_param_type, TYPE_QUAL_RESTRICT);
by_ref = true;
/* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
mech == By_Short_Descriptor);
+ /* Note that, in case of a parameter passed by double reference, the
+ DECL_POINTS_TO_READONLY_P flag is meant for the second reference.
+ The first reference always points to read-only, as it points to
+ the second reference, i.e. the reference to the actual parameter. */
DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr));
DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);
elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
bool definition, bool need_debug)
{
- const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p ();
+ const bool expr_public_p = Is_Public (gnat_entity);
+ const bool expr_global_p = expr_public_p || global_bindings_p ();
bool expr_variable_p, use_variable;
/* In most cases, we won't see a naked FIELD_DECL because a discriminant
if (use_variable || need_debug)
{
tree gnu_decl
- = create_var_decl (create_concat_name (gnat_entity,
- IDENTIFIER_POINTER (gnu_name)),
- NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
- !need_debug, Is_Public (gnat_entity),
- !definition, expr_global_p, NULL, gnat_entity);
+ = create_var_decl_1
+ (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)),
+ NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true, expr_public_p,
+ !definition, expr_global_p, !need_debug, NULL, gnat_entity);
if (use_variable)
return gnu_decl;
tree new_field_type = TREE_TYPE (old_field);
tree new_field, new_size;
- if ((TREE_CODE (new_field_type) == RECORD_TYPE
- || TREE_CODE (new_field_type) == UNION_TYPE
- || TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
+ if (RECORD_OR_UNION_TYPE_P (new_field_type)
&& !TYPE_FAT_POINTER_P (new_field_type)
&& host_integerp (TYPE_SIZE (new_field_type), 1))
new_field_type = make_packable_type (new_field_type, true);
packable version of the record type, see finish_record_type. */
if (!DECL_CHAIN (old_field)
&& !TYPE_PACKED (type)
- && (TREE_CODE (new_field_type) == RECORD_TYPE
- || TREE_CODE (new_field_type) == UNION_TYPE
- || TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
+ && RECORD_OR_UNION_TYPE_P (new_field_type)
&& !TYPE_FAT_POINTER_P (new_field_type)
&& !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
&& TYPE_ADA_SIZE (new_field_type))
between them and it might be hard to overcome afterwards, including
at the RTL level when the stand-alone object is accessed as a whole. */
if (align != 0
- && TREE_CODE (type) == RECORD_TYPE
+ && RECORD_OR_UNION_TYPE_P (type)
&& TYPE_MODE (type) == BLKmode
- && !TREE_ADDRESSABLE (type)
+ && !TYPE_BY_REFERENCE_P (type)
&& TREE_CODE (orig_size) == INTEGER_CST
&& !TREE_OVERFLOW (orig_size)
&& compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
because we cannot create temporaries of non-fixed size in case
we need to take the address of the field. See addressable_p and
the notes on the addressability issues for further details. */
- if (is_variable_size (field_type))
+ if (type_has_variable_size (field_type))
return 0;
/* If the alignment of the record is specified and the field type
effects on the outer record type. A typical case is a field known to be
byte-aligned and not to share a byte with another field. */
if (!needs_strict_alignment
- && TREE_CODE (gnu_field_type) == RECORD_TYPE
+ && RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
&& host_integerp (TYPE_SIZE (gnu_field_type), 1)
&& (packed == 1
}
}
- /* If we are packing the record and the field is BLKmode, round the
- size up to a byte boundary. */
- if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
- gnu_size = round_up (gnu_size, BITS_PER_UNIT);
+ if (Is_Atomic (gnat_field))
+ check_ok_for_atomic (gnu_field_type, gnat_field, false);
if (Present (Component_Clause (gnat_field)))
{
TYPE_ALIGN (gnu_field_type));
else if (Strict_Alignment (gnat_field_type))
- post_error_ne_num
- ("position of & with aliased or tagged components not multiple of ^ bits",
- First_Bit (Component_Clause (gnat_field)), gnat_field,
- TYPE_ALIGN (gnu_field_type));
+ post_error_ne
+ ("position of & is not compatible with alignment required "
+ "by its components",
+ First_Bit (Component_Clause (gnat_field)), gnat_field);
else
gcc_unreachable ();
gnu_pos = NULL_TREE;
}
}
-
- if (Is_Atomic (gnat_field))
- check_ok_for_atomic (gnu_field_type, gnat_field, false);
}
/* If the record has rep clauses and this is the tag field, make a rep
}
else
- gnu_pos = NULL_TREE;
+ {
+ gnu_pos = NULL_TREE;
+
+ /* If we are packing the record and the field is BLKmode, round the
+ size up to a byte boundary. */
+ if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
+ gnu_size = round_up (gnu_size, BITS_PER_UNIT);
+ }
/* We need to make the size the maximum for the type if it is
self-referential and an unconstrained type. In that case, we can't
= create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
+ DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field);
TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
if (Ekind (gnat_field) == E_Discriminant)
return gnu_field;
}
\f
-/* Return true if TYPE is a type with variable size, a padding type with a
- field of variable size or is a record that has a field such a field. */
+/* Return true if TYPE is a type with variable size or a padding type with a
+ field of variable size or a record that has a field with such a type. */
static bool
-is_variable_size (tree type)
+type_has_variable_size (tree type)
{
tree field;
&& !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
return true;
- if (TREE_CODE (type) != RECORD_TYPE
- && TREE_CODE (type) != UNION_TYPE
- && TREE_CODE (type) != QUAL_UNION_TYPE)
+ if (!RECORD_OR_UNION_TYPE_P (type))
return false;
for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
- if (is_variable_size (TREE_TYPE (field)))
+ if (type_has_variable_size (TREE_TYPE (field)))
return true;
return false;
}
\f
+/* Return true if FIELD is an artificial field. */
+
+static bool
+field_is_artificial (tree field)
+{
+ /* These fields are generated by the front-end proper. */
+ if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_')
+ return true;
+
+ /* These fields are generated by gigi. */
+ if (DECL_INTERNAL_P (field))
+ return true;
+
+ return false;
+}
+
+/* Return true if FIELD is a non-artificial aliased field. */
+
+static bool
+field_is_aliased (tree field)
+{
+ if (field_is_artificial (field))
+ return false;
+
+ return DECL_ALIASED_P (field);
+}
+
+/* Return true if FIELD is a non-artificial field with self-referential
+ size. */
+
+static bool
+field_has_self_size (tree field)
+{
+ if (field_is_artificial (field))
+ return false;
+
+ if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+ return false;
+
+ return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field)));
+}
+
+/* Return true if FIELD is a non-artificial field with variable size. */
+
+static bool
+field_has_variable_size (tree field)
+{
+ if (field_is_artificial (field))
+ return false;
+
+ if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+ return false;
+
+ return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST;
+}
+
/* qsort comparer for the bit positions of two record components. */
static int
UNCHECKED_UNION is true if we are building this type for a record with a
Pragma Unchecked_Union.
+ ARTIFICIAL is true if this is a type that was generated by the compiler.
+
DEBUG_INFO is true if we need to write debug information about the type.
MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
REORDER is true if we are permitted to reorder components of this type.
+ FIRST_FREE_POS, if nonzero, is the first (lowest) free field position in
+ the outer record type down to this variant level. It is nonzero only if
+ all the fields down to this level have a rep clause and ALL_REP is false.
+
P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
with a rep clause is to be added; in this case, that is all that should
be done with such fields. */
components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition,
bool cancel_alignment, bool all_rep,
- bool unchecked_union, bool debug_info,
- bool maybe_unused, bool reorder,
- tree *p_gnu_rep_list)
+ bool unchecked_union, bool artificial,
+ bool debug_info, bool maybe_unused, bool reorder,
+ tree first_free_pos, tree *p_gnu_rep_list)
{
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
bool layout_with_rep = false;
+ bool has_self_field = false;
+ bool has_aliased_after_self_field = false;
Node_Id component_decl, variant_part;
tree gnu_field, gnu_next, gnu_last;
+ tree gnu_rep_part = NULL_TREE;
tree gnu_variant_part = NULL_TREE;
tree gnu_rep_list = NULL_TREE;
tree gnu_var_list = NULL_TREE;
gnu_field_list = gnu_field;
if (!gnu_last)
gnu_last = gnu_field;
+
+ /* And record information for the final layout. */
+ if (field_has_self_size (gnu_field))
+ has_self_field = true;
+ else if (has_self_field && field_is_aliased (gnu_field))
+ has_aliased_after_self_field = true;
}
}
= concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
"XVN");
tree gnu_union_type, gnu_union_name;
- tree gnu_variant_list = NULL_TREE;
+ tree this_first_free_pos, gnu_variant_list = NULL_TREE;
if (TREE_CODE (gnu_name) == TYPE_DECL)
gnu_name = DECL_NAME (gnu_name);
gnu_union_name
= concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
- /* Reuse an enclosing union if all fields are in the variant part
- and there is no representation clause on the record, to match
- the layout of C unions. There is an associated check below. */
- if (!gnu_field_list
- && TREE_CODE (gnu_record_type) == UNION_TYPE
- && !TYPE_PACKED (gnu_record_type))
+ /* Reuse the enclosing union if this is an Unchecked_Union whose fields
+ are all in the variant part, to match the layout of C unions. There
+ is an associated check below. */
+ if (TREE_CODE (gnu_record_type) == UNION_TYPE)
gnu_union_type = gnu_record_type;
else
{
TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
}
+ /* If all the fields down to this level have a rep clause, find out
+ whether all the fields at this level also have one. If so, then
+ compute the new first free position to be passed downward. */
+ this_first_free_pos = first_free_pos;
+ if (this_first_free_pos)
+ {
+ for (gnu_field = gnu_field_list;
+ gnu_field;
+ gnu_field = DECL_CHAIN (gnu_field))
+ if (DECL_FIELD_OFFSET (gnu_field))
+ {
+ tree pos = bit_position (gnu_field);
+ if (!tree_int_cst_lt (pos, this_first_free_pos))
+ this_first_free_pos
+ = size_binop (PLUS_EXPR, pos, DECL_SIZE (gnu_field));
+ }
+ else
+ {
+ this_first_free_pos = NULL_TREE;
+ break;
+ }
+ }
+
for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type);
/* Similarly, if the outer record has a size specified and all
- fields have record rep clauses, we can propagate the size
- into the variant part. */
+ the fields have a rep clause, we can propagate the size. */
if (all_rep_and_size)
{
TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type);
we aren't sure to really use it at this point, see below. */
components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition,
- !all_rep_and_size, all_rep,
- unchecked_union, debug_info,
- true, reorder, &gnu_rep_list);
+ !all_rep_and_size, all_rep, unchecked_union,
+ true, debug_info, true, reorder,
+ this_first_free_pos,
+ all_rep || this_first_free_pos
+ ? NULL : &gnu_rep_list);
gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
-
Set_Present_Expr (variant, annotate_value (gnu_qual));
- /* If this is an Unchecked_Union and we have exactly one field,
- use this field directly to match the layout of C unions. */
- if (unchecked_union
- && TYPE_FIELDS (gnu_variant_type)
- && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type)))
- gnu_field = TYPE_FIELDS (gnu_variant_type);
+ /* If this is an Unchecked_Union whose fields are all in the variant
+ part and we have a single field with no representation clause or
+ placed at offset zero, use the field directly to match the layout
+ of C unions. */
+ if (TREE_CODE (gnu_record_type) == UNION_TYPE
+ && (gnu_field = TYPE_FIELDS (gnu_variant_type)) != NULL_TREE
+ && !DECL_CHAIN (gnu_field)
+ && (!DECL_FIELD_OFFSET (gnu_field)
+ || integer_zerop (bit_position (gnu_field))))
+ DECL_CONTEXT (gnu_field) = gnu_union_type;
else
{
/* Deal with packedness like in gnat_to_gnu_field. */
gnu_variant_part
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
all_rep ? TYPE_SIZE (gnu_union_type) : 0,
- all_rep ? bitsize_zero_node : 0,
+ all_rep || this_first_free_pos
+ ? bitsize_zero_node : 0,
union_field_packed, 0);
DECL_INTERNAL_P (gnu_variant_part) = 1;
- DECL_CHAIN (gnu_variant_part) = gnu_field_list;
- gnu_field_list = gnu_variant_part;
}
}
+ /* From now on, a zero FIRST_FREE_POS is totally useless. */
+ if (first_free_pos && integer_zerop (first_free_pos))
+ first_free_pos = NULL_TREE;
+
/* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are
permitted to reorder components, self-referential sizes or variable sizes.
If they do, pull them out and put them onto the appropriate list. We have
continue;
}
- if (reorder)
+ if ((reorder || has_aliased_after_self_field)
+ && field_has_self_size (gnu_field))
{
- /* Pull out the variant part and put it onto GNU_SELF_LIST. */
- if (gnu_field == gnu_variant_part)
- {
- MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
- continue;
- }
-
- /* Skip internal fields and fields with fixed size. */
- if (!DECL_INTERNAL_P (gnu_field)
- && !(DECL_SIZE (gnu_field)
- && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST))
- {
- tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field));
-
- if (CONTAINS_PLACEHOLDER_P (type_size))
- {
- MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
- continue;
- }
+ MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
+ continue;
+ }
- if (TREE_CODE (type_size) != INTEGER_CST)
- {
- MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
- continue;
- }
- }
+ if (reorder && field_has_variable_size (gnu_field))
+ {
+ MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
+ continue;
}
gnu_last = gnu_field;
#undef MOVE_FROM_FIELD_LIST_TO
- /* If permitted, we reorder the components as follows:
+ /* If permitted, we reorder the fields as follows:
1) all fixed length fields,
2) all fields whose length doesn't depend on discriminants,
= chainon (nreverse (gnu_self_list),
chainon (nreverse (gnu_var_list), gnu_field_list));
- /* If we have any fields in our rep'ed field list and it is not the case that
- all the fields in the record have rep clauses and P_REP_LIST is nonzero,
- set it and ignore these fields. */
- if (gnu_rep_list && p_gnu_rep_list && !all_rep)
+ /* Otherwise, if there is an aliased field placed after a field whose length
+ depends on discriminants, we put all the fields of the latter sort, last.
+ We need to do this in case an object of this record type is mutable. */
+ else if (has_aliased_after_self_field)
+ gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list);
+
+ /* If P_REP_LIST is nonzero, this means that we are asked to move the fields
+ in our REP list to the previous level because this level needs them in
+ order to do a correct layout, i.e. avoid having overlapping fields. */
+ if (p_gnu_rep_list && gnu_rep_list)
*p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_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. */
+ record, before the others, if we also have fields without rep clause. */
else if (gnu_rep_list)
{
tree gnu_rep_type
if (gnu_field_list)
{
finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info);
- gnu_field
- = create_field_decl (get_identifier ("REP"), gnu_rep_type,
- gnu_record_type, NULL_TREE, NULL_TREE, 0, 1);
- DECL_INTERNAL_P (gnu_field) = 1;
- gnu_field_list = chainon (gnu_field_list, gnu_field);
+
+ /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields
+ without rep clause are laid out starting from this position.
+ Therefore, we force it as a minimal size on the REP part. */
+ gnu_rep_part
+ = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);
}
else
{
}
}
+ /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields without
+ rep clause are laid out starting from this position. Therefore, if we
+ have not already done so, we create a fake REP part with this size. */
+ if (first_free_pos && !layout_with_rep && !gnu_rep_part)
+ {
+ tree gnu_rep_type = make_node (RECORD_TYPE);
+ finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info);
+ gnu_rep_part
+ = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);
+ }
+
+ /* Now chain the REP part at the end of the reversed field list. */
+ if (gnu_rep_part)
+ gnu_field_list = chainon (gnu_field_list, gnu_rep_part);
+
+ /* And the variant part at the beginning. */
+ if (gnu_variant_part)
+ {
+ DECL_CHAIN (gnu_variant_part) = gnu_field_list;
+ gnu_field_list = gnu_variant_part;
+ }
+
if (cancel_alignment)
TYPE_ALIGN (gnu_record_type) = 0;
finish_record_type (gnu_record_type, nreverse (gnu_field_list),
- layout_with_rep ? 1 : 0, debug_info && !maybe_unused);
+ layout_with_rep ? 1 : 0, false);
+ TYPE_ARTIFICIAL (gnu_record_type) = artificial;
+ if (debug_info && !maybe_unused)
+ rest_of_record_type_compilation (gnu_record_type);
}
\f
/* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
v->type = variant_type;
v->field = gnu_field;
v->qual = qual;
- v->record = NULL_TREE;
+ v->new_type = NULL_TREE;
/* Recurse on the variant subpart of the variant, if any. */
variant_subpart = get_variant_part (variant_type);
SET_TYPE_RM_SIZE (gnu_type, size);
/* ...or the Ada size for record and union types. */
- else if ((TREE_CODE (gnu_type) == RECORD_TYPE
- || TREE_CODE (gnu_type) == UNION_TYPE
- || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+ else if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type))
SET_TYPE_ADA_SIZE (gnu_type, size);
}
/* Only do something if the type is not a packed array type and
doesn't already have the proper size. */
- if (TYPE_PACKED_ARRAY_TYPE_P (type)
+ if (TYPE_IS_PACKED_ARRAY_TYPE_P (type)
|| (TYPE_PRECISION (type) == size && biased_p == for_biased))
break;
return new_field;
}
+/* Create the REP part of RECORD_TYPE with REP_TYPE. If MIN_SIZE is nonzero,
+ it is the minimal size the REP_PART must have. */
+
+static tree
+create_rep_part (tree rep_type, tree record_type, tree min_size)
+{
+ tree field;
+
+ if (min_size && !tree_int_cst_lt (TYPE_SIZE (rep_type), min_size))
+ min_size = NULL_TREE;
+
+ field = create_field_decl (get_identifier ("REP"), rep_type, record_type,
+ min_size, bitsize_zero_node, 0, 1);
+ DECL_INTERNAL_P (field) = 1;
+
+ return field;
+}
+
/* Return the REP part of RECORD_TYPE, if any. Otherwise return NULL. */
static tree
tree field = TYPE_FIELDS (record_type);
/* The REP part is the first field, internal, another record, and its name
- doesn't start with an underscore (i.e. is not generated by the FE). */
- if (DECL_INTERNAL_P (field)
+ starts with an 'R'. */
+ if (field
+ && DECL_INTERNAL_P (field)
&& TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
- && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_')
+ && IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R')
return field;
return NULL_TREE;
/* First create the type of the variant part from that of the old one. */
new_union_type = make_node (QUAL_UNION_TYPE);
- TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type));
+ TYPE_NAME (new_union_type)
+ = concat_name (TYPE_NAME (record_type),
+ IDENTIFIER_POINTER (DECL_NAME (old_variant_part)));
/* If the position of the variant part is constant, subtract it from the
size of the type of the parent to get the new size. This manual CSE
continue;
/* Retrieve the list of fields already added to the new variant. */
- new_variant = v->record;
+ new_variant = v->new_type;
field_list = TYPE_FIELDS (new_variant);
/* If the old variant had a variant subpart, we need to create a new
rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))),
DECL_SIZE (TYPE_FIELDS (gnu_type)));
- /* For record types, we store the size explicitly. */
- if ((TREE_CODE (gnu_type) == RECORD_TYPE
- || TREE_CODE (gnu_type) == UNION_TYPE
- || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
+ /* 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_ADA_SIZE (gnu_type))
return TYPE_ADA_SIZE (gnu_type);