static bool array_type_has_nonaliased_component (tree, Entity_Id);
static bool compile_time_known_address_p (Node_Id);
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, tree *,
bool, bool, bool, bool, bool);
static Uint annotate_value (tree);
/* True if we made GNU_DECL and its type here. */
bool this_made_decl = false;
/* True if debug info is requested for this entity. */
- bool debug_info_p = Needs_Debug_Info (gnat_entity);
+ bool debug_info_p = (Needs_Debug_Info (gnat_entity)
+ || debug_info_level == DINFO_LEVEL_VERBOSE);
/* True if this entity is to be considered as imported. */
bool imported_p = (Is_Imported (gnat_entity)
&& No (Address_Clause (gnat_entity)));
&& !TREE_SIDE_EFFECTS (gnu_expr))))
{
maybe_stable_expr
- = gnat_stabilize_reference (gnu_expr, true, &stable);
+ = maybe_stabilize_reference (gnu_expr, true, &stable);
if (stable)
{
else
{
maybe_stable_expr
- = gnat_stabilize_reference (gnu_expr, true, &stable);
+ = maybe_stabilize_reference (gnu_expr, true, &stable);
if (stable)
renamed_obj = maybe_stable_expr;
as we have a VAR_DECL for the pointer we make. */
}
- gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
- maybe_stable_expr);
+ gnu_expr
+ = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
gnu_size = NULL_TREE;
used_by_ref = true;
|| Is_Exported (gnat_entity)))))
gnu_ext_name = create_concat_name (gnat_entity, NULL);
- /* If this is an aggregate constant initialized to a constant, force it
- to be statically allocated. This saves an initialization copy. */
- if (!static_p
- && const_flag
+ /* If this is constant initialized to a static constant and the
+ object has an aggregate type, force it to be statically
+ allocated. This will avoid an initialization copy. */
+ if (!static_p && const_flag
&& gnu_expr && TREE_CONSTANT (gnu_expr)
&& AGGREGATE_TYPE_P (gnu_type)
&& host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
(TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
static_p = true;
- gnu_decl
- = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
- gnu_expr, const_flag, Is_Public (gnat_entity),
- imported_p || !definition, static_p, attr_list,
- gnat_entity);
+ gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
+ gnu_expr, const_flag,
+ Is_Public (gnat_entity),
+ imported_p || !definition,
+ static_p, attr_list, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
DECL_IGNORED_P (gnu_decl) = 1;
}
- /* If this is a constant, even if we don't need a true variable, we
- may need to avoid returning the initializer in every case. That
- can happen for the address of a (constant) constructor because,
- upon dereferencing it, the constructor will be reinjected in the
- tree, which may not be valid in every case; see lvalue_required_p
- for more details. */
- if (TREE_CODE (gnu_decl) == CONST_DECL)
- DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
-
/* If this is declared in a block that contains a block with an
exception handler, we must force this variable in memory to
suppress an invalid optimization. */
/* ...and reference the _Parent field of this record. */
gnu_field
- = create_field_decl (parent_name_id,
+ = create_field_decl (get_identifier
+ (Get_Name_String (Name_uParent)),
gnu_parent, gnu_type, 0,
has_rep
? TYPE_SIZE (gnu_parent) : NULL_TREE,
false, all_rep, is_unchecked_union,
debug_info_p, false);
- /* If it is passed by reference, force BLKmode to ensure that objects
-+ of this type will always be put in memory. */
- if (Is_By_Reference_Type (gnat_entity))
+ /* If it is a tagged record force the type to BLKmode to insure that
+ these objects will always be put in memory. Likewise for limited
+ record types. */
+ if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
/* We used to remove the associations of the discriminants and _Parent
finish_record_type (gnu_type, gnu_field_list, 2, false);
/* See the E_Record_Type case for the rationale. */
- if (Is_By_Reference_Type (gnat_entity))
+ if (Is_Tagged_Type (gnat_entity)
+ || Is_Limited_Record (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
else
compute_record_mode (gnu_type);
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
TYPE_POINTER_TO (gnu_old) = gnu_type;
+ Sloc_to_locus (Sloc (gnat_entity), &input_location);
fields
= chainon (chainon (NULL_TREE,
create_field_decl
| (TYPE_QUAL_CONST * const_flag)
| (TYPE_QUAL_VOLATILE * volatile_flag));
+ Sloc_to_locus (Sloc (gnat_entity), &input_location);
+
if (has_stub)
gnu_stub_type
= build_qualified_type (gnu_stub_type,
break;
}
+ /* Simple class_wide types are always viewed as their root_type
+ by Gigi unless an Equivalent_Type is specified. */
case E_Class_Wide_Type:
- /* Class-wide types are always transformed into their root type. */
gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0);
maybe_present = true;
break;
handling alignment and possible padding. */
if (is_type && (!gnu_decl || this_made_decl))
{
- /* Tell the middle-end that objects of tagged types are guaranteed to
- be properly aligned. This is necessary because conversions to the
- class-wide type are translated into conversions to the root type,
- which can be less aligned than some of its derived types. */
if (Is_Tagged_Type (gnat_entity)
|| 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;
+ if (AGGREGATE_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
if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
{
+ /* If the size is self-referential, we annotate the maximum
+ value of that size. */
tree gnu_size = TYPE_SIZE (gnu_type);
- /* If the size is self-referential, annotate the maximum value. */
if (CONTAINS_PLACEHOLDER_P (gnu_size))
gnu_size = max_size (gnu_size, true);
+ Set_Esize (gnat_entity, annotate_value (gnu_size));
+
if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
- /* In this mode, the tag and the parent components are not
- generated by the front-end so the sizes must be adjusted. */
- tree pointer_size = bitsize_int (POINTER_SIZE), offset;
- Uint uint_size;
+ /* In this mode the tag and the parent components are not
+ generated by the front-end, so the sizes must be adjusted
+ explicitly now. */
+ int size_offset, new_size;
if (Is_Derived_Type (gnat_entity))
{
- offset = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
- bitsizetype);
+ size_offset
+ = UI_To_Int (Esize (Etype (Base_Type (gnat_entity))));
Set_Alignment (gnat_entity,
Alignment (Etype (Base_Type (gnat_entity))));
}
else
- offset = pointer_size;
-
- gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
- gnu_size = size_binop (MULT_EXPR, pointer_size,
- size_binop (CEIL_DIV_EXPR,
- gnu_size,
- pointer_size));
- uint_size = annotate_value (gnu_size);
- Set_Esize (gnat_entity, uint_size);
- Set_RM_Size (gnat_entity, uint_size);
+ size_offset = POINTER_SIZE;
+
+ new_size = UI_To_Int (Esize (gnat_entity)) + size_offset;
+ Set_Esize (gnat_entity,
+ UI_From_Int (((new_size + (POINTER_SIZE - 1))
+ / POINTER_SIZE) * POINTER_SIZE));
+ Set_RM_Size (gnat_entity, Esize (gnat_entity));
}
- else
- Set_Esize (gnat_entity, annotate_value (gnu_size));
}
if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type))
return Compile_Time_Known_Value (gnat_address);
}
-/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e. if the
- inequality HB >= LB-1 is true. LB and HB are the low and high bounds. */
+/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e.
+ cannot verify HB < LB-1 when LB and HB are the low and high bounds. */
static bool
cannot_be_superflat_p (Node_Id gnat_range)
{
Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
Node_Id scalar_range;
+
tree gnu_lb, gnu_hb;
/* If the low bound is not constant, try to find an upper bound. */
return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0);
}
-
-/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR. */
-
-static bool
-constructor_address_p (tree gnu_expr)
-{
- while (TREE_CODE (gnu_expr) == NOP_EXPR
- || TREE_CODE (gnu_expr) == CONVERT_EXPR
- || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR)
- gnu_expr = TREE_OPERAND (gnu_expr, 0);
-
- return (TREE_CODE (gnu_expr) == ADDR_EXPR
- && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
-}
\f
/* Given GNAT_ENTITY, elaborate all expressions that are required to
be elaborated at the point of its definition, but do nothing else. */
}
}
\f
+/* Called when we need to protect a variable object using a SAVE_EXPR. */
+
+tree
+maybe_variable (tree gnu_operand)
+{
+ if (TREE_CONSTANT (gnu_operand)
+ || TREE_READONLY (gnu_operand)
+ || TREE_CODE (gnu_operand) == SAVE_EXPR
+ || TREE_CODE (gnu_operand) == NULL_EXPR)
+ return gnu_operand;
+
+ if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF)
+ {
+ tree gnu_result
+ = build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand),
+ variable_size (TREE_OPERAND (gnu_operand, 0)));
+
+ TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result)
+ = TYPE_READONLY (TREE_TYPE (TREE_TYPE (gnu_operand)));
+ return gnu_result;
+ }
+
+ return variable_size (gnu_operand);
+}
+\f
/* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
type definition (either a bound or a discriminant value) for GNAT_ENTITY,
return the GCC tree to use for that expression. GNU_NAME is the suffix
if (expr_global && expr_variable)
return gnu_decl;
- return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
+ return expr_variable ? maybe_variable (gnu_expr) : gnu_expr;
}
\f
/* Create a record type that contains a SIZE bytes long field of TYPE with a
!DECL_NONADDRESSABLE_P (old_field));
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
+ SET_DECL_ORIGINAL_FIELD
+ (new_field, (DECL_ORIGINAL_FIELD (old_field)
+ ? DECL_ORIGINAL_FIELD (old_field) : old_field));
+
if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
static Uint
annotate_value (tree gnu_size)
{
+ int len = TREE_CODE_LENGTH (TREE_CODE (gnu_size));
TCode tcode;
Node_Ref_Or_Val ops[3], ret;
+ int i;
+ int size;
struct tree_int_map **h = NULL;
- int size, i;
/* See if we've already saved the value for this node. */
if (EXPR_P (gnu_size))
for (i = 0; i < 3; i++)
ops[i] = No_Uint;
- for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
+ for (i = 0; i < len; i++)
{
ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
if (ops[i] == No_Uint)
UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
}
-/* Return first element of field list whose TREE_PURPOSE is the same as ELEM.
- Return NULL_TREE if there is no such element in the list. */
+/* Return first element of field list whose TREE_PURPOSE is ELEM or whose
+ DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM. Return NULL_TREE if there
+ is no such element in the list. */
static tree
purpose_member_field (const_tree elem, tree list)
while (list)
{
tree field = TREE_PURPOSE (list);
- if (SAME_FIELD_P (field, elem))
+ if (elem == field || elem == DECL_ORIGINAL_FIELD (field))
return list;
list = TREE_CHAIN (list);
}
Node_Id gnat_error_node;
tree type_size, size;
- /* Return 0 if no size was specified. */
- if (uint_size == No_Uint)
- return NULL_TREE;
+ if (kind == VAR_DECL
+ /* If a type needs strict alignment, a component of this type in
+ a packed record cannot be packed and thus uses the type size. */
+ || (kind == TYPE_DECL && Strict_Alignment (gnat_object)))
+ type_size = TYPE_SIZE (gnu_type);
+ else
+ type_size = rm_size (gnu_type);
/* Find the node to use for errors. */
if ((Ekind (gnat_object) == E_Component
else
gnat_error_node = gnat_object;
+ /* Return 0 if no size was specified, either because Esize was not Present
+ or the specified size was zero. */
+ if (No (uint_size) || uint_size == No_Uint)
+ return NULL_TREE;
+
/* Get the size as a tree. Issue an error if a size was specified but
cannot be represented in sizetype. */
size = UI_To_gnu (uint_size, bitsizetype);
if (TREE_OVERFLOW (size))
{
- if (component_p)
- post_error_ne ("component size of & is too large", gnat_error_node,
- gnat_object);
- else
- post_error_ne ("size of & is too large", gnat_error_node,
- gnat_object);
+ post_error_ne (component_p ? "component size of & is too large"
+ : "size of & is too large",
+ gnat_error_node, gnat_object);
return NULL_TREE;
}
&& TYPE_CONTAINS_TEMPLATE_P (gnu_type))
size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size);
- if (kind == VAR_DECL
- /* If a type needs strict alignment, a component of this type in
- a packed record cannot be packed and thus uses the type size. */
- || (kind == TYPE_DECL && Strict_Alignment (gnat_object)))
- type_size = TYPE_SIZE (gnu_type);
- else
- type_size = rm_size (gnu_type);
-
/* Modify the size of the type to be that of the maximum size if it has a
discriminant. */
if (type_size && CONTAINS_PLACEHOLDER_P (type_size))
by the smallest integral mode that's valid for pointers. */
if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type))
{
- enum machine_mode p_mode = GET_CLASS_NARROWEST_MODE (MODE_INT);
- while (!targetm.valid_pointer_mode (p_mode))
- p_mode = GET_MODE_WIDER_MODE (p_mode);
+ enum machine_mode p_mode;
+
+ for (p_mode = GET_CLASS_NARROWEST_MODE (MODE_INT);
+ !targetm.valid_pointer_mode (p_mode);
+ p_mode = GET_MODE_WIDER_MODE (p_mode))
+ ;
+
type_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
}
("component size for& too small{, minimum allowed is ^}",
gnat_error_node, gnat_object, type_size);
else
- post_error_ne_tree
- ("size for& too small{, minimum allowed is ^}",
- gnat_error_node, gnat_object, type_size);
+ post_error_ne_tree ("size for& too small{, minimum allowed is ^}",
+ gnat_error_node, gnat_object, type_size);
+
+ if (kind == VAR_DECL && !component_p
+ && TREE_CODE (rm_size (gnu_type)) == INTEGER_CST
+ && !tree_int_cst_lt (size, rm_size (gnu_type)))
+ post_error_ne_tree_2
+ ("\\size of ^ is not a multiple of alignment (^ bits)",
+ gnat_error_node, gnat_object, rm_size (gnu_type),
+ TYPE_ALIGN (gnu_type));
+
+ else if (INTEGRAL_TYPE_P (gnu_type))
+ post_error_ne ("\\size would be legal if & were not aliased!",
+ gnat_error_node, gnat_object);
- size = NULL_TREE;
+ return NULL_TREE;
}
return size;
static void
set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
{
- Node_Id gnat_attr_node;
- tree old_size, size;
-
- /* Do nothing if no size was specified. */
- if (uint_size == No_Uint)
- return;
-
/* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */
- gnat_attr_node
+ Node_Id gnat_attr_node
= Get_Attribute_Definition_Clause (gnat_entity, Attr_Value_Size);
+ tree old_size = rm_size (gnu_type), size;
+
+ /* Do nothing if no size was specified, either because RM size was not
+ Present or if the specified size was zero. */
+ if (No (uint_size) || uint_size == No_Uint)
+ return;
/* Get the size as a tree. Issue an error if a size was specified but
cannot be represented in sizetype. */
&& !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
return;
- old_size = rm_size (gnu_type);
-
/* If the old size is self-referential, get the maximum size. */
if (CONTAINS_PLACEHOLDER_P (old_size))
old_size = max_size (old_size, true);
&& TYPE_PACKED_ARRAY_TYPE_P (gnu_type))
&& !(TYPE_IS_PADDING_P (gnu_type)
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == ARRAY_TYPE
- && TYPE_PACKED_ARRAY_TYPE_P
- (TREE_TYPE (TYPE_FIELDS (gnu_type))))
+ && TYPE_PACKED_ARRAY_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_type))))
&& tree_int_cst_lt (size, old_size)))
{
if (Present (gnat_attr_node))
SET_TYPE_RM_MAX_VALUE (new_type,
convert (TREE_TYPE (new_type),
TYPE_MAX_VALUE (type)));
- /* Copy the name to show that it's essentially the same type and
- not a subrange type. */
- TYPE_NAME (new_type) = TYPE_NAME (type);
+ /* Propagate the name to avoid creating a fake subrange type. */
+ if (TYPE_NAME (type))
+ {
+ if (TREE_CODE (TYPE_NAME (type)) == TYPE_DECL)
+ TYPE_NAME (new_type) = DECL_NAME (TYPE_NAME (type));
+ else
+ TYPE_NAME (new_type) = TYPE_NAME (type);
+ }
TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
return new_type;
}
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
+ t = DECL_ORIGINAL_FIELD (old_field);
+ SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field);
DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field);
TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field);
}
DECL_CONTEXT (new_field) = nt;
- SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field);
+ SET_DECL_ORIGINAL_FIELD (new_field,
+ (DECL_ORIGINAL_FIELD (field)
+ ? DECL_ORIGINAL_FIELD (field) : field));
TREE_CHAIN (new_field) = TYPE_FIELDS (nt);
TYPE_FIELDS (nt) = new_field;