* *
* C Implementation File *
* *
- * Copyright (C) 1992-2009, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2010, 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- *
static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
static bool is_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 tree make_packable_type (tree, bool);
static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *);
static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
static bool same_discriminant_p (Entity_Id, Entity_Id);
-static bool array_type_has_nonaliased_component (Entity_Id, tree);
+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);
const Entity_Kind kind = Ekind (gnat_entity);
/* True if this is a type. */
const bool is_type = IN (kind, Type_Kind);
+ /* True if debug info is requested for this entity. */
+ const bool debug_info_p = Needs_Debug_Info (gnat_entity);
+ /* True if this entity is to be considered as imported. */
+ const bool imported_p
+ = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));
/* For a type, contains the equivalent GNAT node to be used in gigi. */
Entity_Id gnat_equiv_type = Empty;
/* Temporary used to walk the GNAT tree. */
bool maybe_present = false;
/* 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)
- || 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)));
/* Size and alignment of the GCC node, if meaningful. */
unsigned int esize = 0, align = 0;
/* Contains the list of attributes directly attached to the entity. */
case E_Out_Parameter:
case E_Variable:
- /* Simple variables, loop variables, Out parameters, and exceptions. */
+ /* Simple variables, loop variables, Out parameters and exceptions. */
object:
{
- bool used_by_ref = false;
bool const_flag
= ((kind == E_Constant || kind == E_Variable)
&& Is_True_Constant (gnat_entity)
bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity);
bool mutable_p = false;
+ bool used_by_ref = false;
tree gnu_ext_name = NULL_TREE;
tree renamed_obj = NULL_TREE;
tree gnu_object_size;
if (kind == E_Loop_Parameter)
gnu_type = get_base_type (gnu_type);
- /* Reject non-renamed objects whose types are unconstrained arrays or
- any object whose type is a dummy type or VOID_TYPE. */
-
+ /* Reject non-renamed objects whose type is an unconstrained array or
+ any object whose type is a dummy type or void. */
if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
&& No (Renamed_Object (gnat_entity)))
|| TYPE_IS_DUMMY_P (gnu_type)
gcc_assert (Present (Alignment (gnat_entity)));
align = validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (gnu_type));
+
/* No point in changing the type if there is an address clause
as the final type of the object will be a reference type. */
if (Present (Address_Clause (gnat_entity)))
else
gnu_type
= maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,
- "PAD", false, definition, true);
+ false, false, definition, true);
}
- /* If we are defining the object, see if it has a Size value and
- validate it if so. If we are not defining the object and a Size
- clause applies, simply retrieve the value. We don't want to ignore
- the clause and it is expected to have been validated already. Then
- get the new type, if any. */
+ /* If we are defining the object, see if it has a Size and validate it
+ if so. If we are not defining the object and a Size clause applies,
+ simply retrieve the value. We don't want to ignore the clause and
+ it is expected to have been validated already. Then get the new
+ type, if any. */
if (definition)
gnu_size = validate_size (Esize (gnat_entity), gnu_type,
gnat_entity, VAR_DECL, false,
}
/* If this object has self-referential size, it must be a record with
- a default value. We are supposed to allocate an object of the
- maximum size in this case unless it is a constant with an
+ a default discriminant. We are supposed to allocate an object of
+ the maximum size in this case, unless it is a constant with an
initializing expression, in which case we can get the size from
that. Note that the resulting size may still be a variable, so
this may end up with an indirect allocation. */
despite having a nominal type with self-referential
size, we can get the size directly from it. */
if (TREE_CODE (gnu_expr) == COMPONENT_REF
- && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
- == RECORD_TYPE
&& TYPE_IS_PADDING_P
(TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
&& TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == VAR_DECL
}
}
- /* If the size is zero bytes, make it one byte since some linkers have
- trouble with zero-sized objects. If the object will have a
+ /* If the size is zero byte, make it one byte since some linkers have
+ troubles with zero-sized objects. If the object will have a
template, that will make it nonzero so don't bother. Also avoid
doing that for an object renaming or an object with an address
clause, as we would lose useful information on the view size
??? Note that we ignore Has_Volatile_Components on objects; it's
not at all clear what to do in that case. */
-
if (Has_Atomic_Components (gnat_entity))
{
tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE
/* Now check if the type of the object allows atomic access. Note
that we must test the type, even if this object has size and
- alignment to allow such access, because we will be going
- inside the padded record to assign to the object. We could fix
- this by always copying via an intermediate value, but it's not
- clear it's worth the effort. */
+ alignment to allow such access, because we will be going inside
+ the padded record to assign to the object. We could fix this by
+ always copying via an intermediate value, but it's not clear it's
+ worth the effort. */
if (Is_Atomic (gnat_entity))
check_ok_for_atomic (gnu_type, gnat_entity, false);
gnu_type
= build_unc_object_type_from_ptr (gnu_fat, gnu_type,
concat_name (gnu_entity_name,
- "UNC"));
+ "UNC"),
+ debug_info_p);
}
#ifdef MINIMUM_ATOMIC_ALIGNMENT
gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
if (gnu_size || align > 0)
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- "PAD", false, definition,
+ false, false, definition,
gnu_size ? true : false);
/* If this is a renaming, avoid as much as possible to create a new
/* If the renamed object had padding, strip off the reference
to the inner object and reset our type. */
if ((TREE_CODE (gnu_expr) == COMPONENT_REF
- && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
- == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
/* Strip useless conversions around the object. */
|| (TREE_CODE (gnu_expr) == NOP_EXPR
&& !TREE_SIDE_EFFECTS (gnu_expr))))
{
maybe_stable_expr
- = maybe_stabilize_reference (gnu_expr, true, &stable);
+ = gnat_stabilize_reference (gnu_expr, true, &stable);
if (stable)
{
else
{
maybe_stable_expr
- = maybe_stabilize_reference (gnu_expr, true, &stable);
+ = gnat_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;
&& !gnu_expr
&& TREE_CODE (gnu_type) == RECORD_TYPE
&& (TYPE_CONTAINS_TEMPLATE_P (gnu_type)
- /* Beware that padding might have been introduced
- via maybe_pad_type above. */
- || (TYPE_IS_PADDING_P (gnu_type)
+ /* Beware that padding might have been introduced above. */
+ || (TYPE_PADDING_P (gnu_type)
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type)))
== RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P
(TREE_TYPE (TYPE_FIELDS (gnu_type))))))
{
tree template_field
- = TYPE_IS_PADDING_P (gnu_type)
+ = TYPE_PADDING_P (gnu_type)
? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type)))
: TYPE_FIELDS (gnu_type);
-
gnu_expr
= gnat_build_constructor
- (gnu_type,
- tree_cons
- (template_field,
- build_template (TREE_TYPE (template_field),
- TREE_TYPE (TREE_CHAIN (template_field)),
- NULL_TREE),
- NULL_TREE));
+ (gnu_type,
+ tree_cons
+ (template_field,
+ build_template (TREE_TYPE (template_field),
+ TREE_TYPE (TREE_CHAIN (template_field)),
+ NULL_TREE),
+ NULL_TREE));
}
/* Convert the expression to the type of the object except in the
if (gnu_expr
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
&& !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type)
- && (CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
+ && !(TYPE_IS_PADDING_P (gnu_type)
+ && CONTAINS_PLACEHOLDER_P
+ (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
gnu_expr = convert (gnu_type, gnu_expr);
- /* If this is a pointer and it does not have an initializing
- expression, initialize it to NULL, unless the object is
- imported. */
+ /* If this is a pointer that doesn't have an initializing expression,
+ initialize it to NULL, unless the object is imported. */
if (definition
- && (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type))
- && !Is_Imported (gnat_entity) && !gnu_expr)
+ && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type))
+ && !gnu_expr
+ && !Is_Imported (gnat_entity))
gnu_expr = integer_zero_node;
/* If we are defining the object and it has an Address clause, we must
effects in this case. */
if (definition && Present (Address_Clause (gnat_entity)))
{
+ Node_Id gnat_expr = Expression (Address_Clause (gnat_entity));
tree gnu_address
= present_gnu_tree (gnat_entity)
- ? get_gnu_tree (gnat_entity)
- : gnat_to_gnu (Expression (Address_Clause (gnat_entity)));
+ ? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_expr);
save_gnu_tree (gnat_entity, NULL_TREE, false);
= build_reference_type_for_mode (gnu_type, ptr_mode, true);
gnu_address = convert (gnu_type, gnu_address);
used_by_ref = true;
- const_flag = !Is_Public (gnat_entity)
- || compile_time_known_address_p (Expression (Address_Clause
- (gnat_entity)));
+ const_flag
+ = !Is_Public (gnat_entity)
+ || compile_time_known_address_p (gnat_expr);
/* If this is a deferred constant, the initializer is attached to
the full view. */
If the object's size overflows, make an allocator too, so that
Storage_Error gets raised. Note that we will never free
such memory, so we presume it never will get allocated. */
-
if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
- global_bindings_p () || !definition
+ global_bindings_p ()
+ || !definition
|| static_p)
- || (gnu_size
- && ! allocatable_size_p (gnu_size,
- global_bindings_p () || !definition
- || static_p)))
+ || (gnu_size && !allocatable_size_p (gnu_size,
+ global_bindings_p ()
+ || !definition
+ || static_p)))
{
gnu_type = build_reference_type (gnu_type);
gnu_size = NULL_TREE;
If we are elaborating a mutable object, tell build_allocator to
ignore a possibly simpler size from the initializer, if any, as
we must allocate the maximum possible size in this case. */
-
if (definition)
{
tree gnu_alloc_type = TREE_TYPE (gnu_type);
if (gnu_expr
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
&& !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type)
- && (CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
+ && !(TYPE_IS_PADDING_P (gnu_type)
+ && CONTAINS_PLACEHOLDER_P
+ (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
gnu_expr = convert (gnu_type, gnu_expr);
/* If this name is external or there was a name specified, use it,
|| Is_Exported (gnat_entity)))))
gnu_ext_name = create_concat_name (gnat_entity, NULL);
- /* 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
+ /* 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
&& gnu_expr && TREE_CONSTANT (gnu_expr)
&& AGGREGATE_TYPE_P (gnu_type)
&& host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type)
+ && !(TYPE_IS_PADDING_P (gnu_type)
&& !host_integerp (TYPE_SIZE_UNIT
(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);
+ /* Now create the variable or the constant and set various flags. */
+ 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 we are defining an Out parameter and optimization isn't enabled,
+ create a fake PARM_DECL for debugging purposes and make it point to
+ the VAR_DECL. Suppress debug info for the latter but make sure it
+ will live on the stack so that it can be accessed from within the
+ debugger through the PARM_DECL. */
+ if (kind == E_Out_Parameter && definition && !optimize && debug_info_p)
+ {
+ tree param = create_param_decl (gnu_entity_name, gnu_type, false);
+ gnat_pushdecl (param, gnat_entity);
+ SET_DECL_VALUE_EXPR (param, gnu_decl);
+ DECL_HAS_VALUE_EXPR_P (param) = 1;
+ DECL_IGNORED_P (gnu_decl) = 1;
+ TREE_ADDRESSABLE (gnu_decl) = 1;
+ }
+
+ /* If this is a renaming pointer, attach the renamed object to it and
+ register it if we are at top level. */
if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
{
SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
}
}
- if (definition && DECL_SIZE_UNIT (gnu_decl)
- && get_block_jmpbuf_decl ()
- && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST
- || (flag_stack_check == GENERIC_STACK_CHECK
- && compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
- STACK_CHECK_MAX_VAR_SIZE) > 0)))
- add_stmt_with_node (build_call_1_expr
- (update_setjmp_buf_decl,
- build_unary_op (ADDR_EXPR, NULL_TREE,
- get_block_jmpbuf_decl ())),
- gnat_entity);
-
- /* If we are defining an Out parameter and we're not optimizing,
- create a fake PARM_DECL for debugging purposes and make it
- point to the VAR_DECL. Suppress debug info for the latter
- but make sure it will still live on the stack so it can be
- accessed from within the debugger through the PARM_DECL. */
- if (kind == E_Out_Parameter && definition && !optimize)
- {
- tree param = create_param_decl (gnu_entity_name, gnu_type, false);
- gnat_pushdecl (param, gnat_entity);
- SET_DECL_VALUE_EXPR (param, gnu_decl);
- DECL_HAS_VALUE_EXPR_P (param) = 1;
- if (debug_info_p)
- debug_info_p = false;
- else
- DECL_IGNORED_P (param) = 1;
- TREE_ADDRESSABLE (gnu_decl) = 1;
- }
-
- /* If this is a public constant or we're not optimizing and we're not
- making a VAR_DECL for it, make one just for export or debugger use.
- Likewise if the address is taken or if either the object or type is
- aliased. Make an external declaration for a reference, unless this
- is a Standard entity since there no real symbol at the object level
- for these. */
+ /* If this is a constant and we are defining it or it generates a real
+ symbol at the object level and we are referencing it, we may want
+ or need to have a true variable to represent it:
+ - if optimization isn't enabled, for debugging purposes,
+ - if the constant is public and not overlaid on something else,
+ - if its address is taken,
+ - if either itself or its type is aliased. */
if (TREE_CODE (gnu_decl) == CONST_DECL
&& (definition || Sloc (gnat_entity) > Standard_Location)
- && ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity)))
- || !optimize
+ && ((!optimize && debug_info_p)
+ || (Is_Public (gnat_entity)
+ && No (Address_Clause (gnat_entity)))
|| Address_Taken (gnat_entity)
|| Is_Aliased (gnat_entity)
|| Is_Aliased (Etype (gnat_entity))))
tree gnu_corr_var
= create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
gnu_expr, true, Is_Public (gnat_entity),
- !definition, static_p, NULL,
+ !definition, static_p, attr_list,
gnat_entity);
SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
/* As debugging information will be generated for the variable,
- do not generate information for the constant. */
- DECL_IGNORED_P (gnu_decl) = 1;
+ do not generate debugging information for the constant. */
+ if (debug_info_p)
+ DECL_IGNORED_P (gnu_decl) = 1;
+ else
+ DECL_IGNORED_P (gnu_corr_var) = 1;
}
- /* 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. */
- if (Has_Nested_Block_With_Handler (Scope (gnat_entity))
- && Exception_Mechanism != Back_End_Exceptions)
+ /* 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 object is declared in a block that contains a block with an
+ exception handler, and we aren't using the GCC exception mechanism,
+ we must force this variable in memory in order to avoid an invalid
+ optimization. */
+ if (Exception_Mechanism != Back_End_Exceptions
+ && Has_Nested_Block_With_Handler (Scope (gnat_entity)))
TREE_ADDRESSABLE (gnu_decl) = 1;
+ /* If we are defining an object with variable size or an object with
+ fixed size that will be dynamically allocated, and we are using the
+ setjmp/longjmp exception mechanism, update the setjmp buffer. */
+ if (definition
+ && Exception_Mechanism == Setjmp_Longjmp
+ && get_block_jmpbuf_decl ()
+ && DECL_SIZE_UNIT (gnu_decl)
+ && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST
+ || (flag_stack_check == GENERIC_STACK_CHECK
+ && compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
+ STACK_CHECK_MAX_VAR_SIZE) > 0)))
+ add_stmt_with_node (build_call_1_expr
+ (update_setjmp_buf_decl,
+ build_unary_op (ADDR_EXPR, NULL_TREE,
+ get_block_jmpbuf_decl ())),
+ gnat_entity);
+
/* Back-annotate Esize and Alignment of the object if not already
known. Note that we pick the values of the type, not those of
the object, to shield ourselves from low-level platform-dependent
break;
}
- /* Normal case of non-character type or non-Standard character type. */
{
- /* Here we have a list of enumeral constants in First_Literal.
- We make a CONST_DECL for each and build into GNU_LITERAL_LIST
- the list to be placed into TYPE_FIELDS. Each node in the list
- is a TREE_LIST whose TREE_VALUE is the literal name and whose
- TREE_PURPOSE is the value of the literal. */
-
- Entity_Id gnat_literal;
+ /* We have a list of enumeral constants in First_Literal. We make a
+ CONST_DECL for each one and build into GNU_LITERAL_LIST the list to
+ be placed into TYPE_FIELDS. Each node in the list is a TREE_LIST
+ whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
+ value of the literal. But when we have a regular boolean type, we
+ simplify this a little by using a BOOLEAN_TYPE. */
+ bool is_boolean = Is_Boolean_Type (gnat_entity)
+ && !Has_Non_Standard_Rep (gnat_entity);
tree gnu_literal_list = NULL_TREE;
+ Entity_Id gnat_literal;
if (Is_Unsigned_Type (gnat_entity))
gnu_type = make_unsigned_type (esize);
else
gnu_type = make_signed_type (esize);
- TREE_SET_CODE (gnu_type, ENUMERAL_TYPE);
+ TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
for (gnat_literal = First_Literal (gnat_entity);
Present (gnat_literal);
gnat_literal = Next_Literal (gnat_literal))
{
- tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal),
- gnu_type);
+ tree gnu_value
+ = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
tree gnu_literal
= create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
gnu_type, gnu_value, true, false, false,
gnu_value, gnu_literal_list);
}
- TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
+ if (!is_boolean)
+ TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
/* Note that the bounds are updated at the end of this function
to avoid an infinite recursion since they refer to the type. */
gnat_to_gnu_type
(Original_Array_Type (gnat_entity)));
+ /* We have to handle clauses that under-align the type specially. */
+ if ((Present (Alignment_Clause (gnat_entity))
+ || (Is_Packed_Array_Type (gnat_entity)
+ && Present
+ (Alignment_Clause (Original_Array_Type (gnat_entity)))))
+ && UI_Is_In_Int_Range (Alignment (gnat_entity)))
+ {
+ align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT;
+ if (align >= TYPE_ALIGN (gnu_type))
+ align = 0;
+ }
+
/* If the type we are dealing with represents a bit-packed array,
we need to have the bits left justified on big-endian targets
and right justified on little-endian targets. We also need to
{
tree gnu_field_type, gnu_field;
- /* Set the RM size before wrapping up the type. */
+ /* Set the RM size before wrapping up the original type. */
SET_TYPE_RM_SIZE (gnu_type,
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
+
+ /* Create a stripped-down declaration, mainly for debugging. */
+ create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+ debug_info_p, gnat_entity);
+
+ /* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM");
-
- /* Propagate the alignment of the modular type to the record.
- This means that bit-packed arrays have "ceil" alignment for
- their size, which may seem counter-intuitive but makes it
- possible to easily overlay them on modular types. */
- TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_field_type);
TYPE_PACKED (gnu_type) = 1;
+ TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+ TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+ SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+
+ /* Propagate the alignment of the modular type to the record type,
+ unless there is an alignment clause that under-aligns the type.
+ This means that bit-packed arrays are given "ceil" alignment for
+ their size by default, which may seem counter-intuitive but makes
+ it possible to overlay them on modular types easily. */
+ TYPE_ALIGN (gnu_type)
+ = align > 0 ? align : TYPE_ALIGN (gnu_field_type);
- /* Create a stripped-down declaration of the original type, mainly
- for debugging. */
- create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
- debug_info_p, gnat_entity);
+ relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
/* Don't notify the field as "addressable", since we won't be taking
it's address and it would prevent create_field_decl from making a
bitfield. */
- gnu_field = create_field_decl (get_identifier ("OBJECT"),
- gnu_field_type, gnu_type, 1, 0, 0, 0);
+ gnu_field
+ = create_field_decl (get_identifier ("OBJECT"), gnu_field_type,
+ gnu_type, NULL_TREE, bitsize_zero_node, 1, 0);
- /* Do not finalize it until after the parallel type is added. */
- finish_record_type (gnu_type, gnu_field, 0, true);
+ /* Do not emit debug info until after the parallel type is added. */
+ finish_record_type (gnu_type, gnu_field, 2, false);
+ compute_record_mode (gnu_type);
TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
- relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
-
- /* Make the original array type a parallel type. */
- if (debug_info_p
- && present_gnu_tree (Original_Array_Type (gnat_entity)))
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
- gnat_to_gnu_type
- (Original_Array_Type (gnat_entity)));
+ if (debug_info_p)
+ {
+ /* Make the original array type a parallel type. */
+ if (present_gnu_tree (Original_Array_Type (gnat_entity)))
+ add_parallel_type (TYPE_STUB_DECL (gnu_type),
+ gnat_to_gnu_type
+ (Original_Array_Type (gnat_entity)));
- rest_of_record_type_compilation (gnu_type);
+ rest_of_record_type_compilation (gnu_type);
+ }
}
/* If the type we are dealing with has got a smaller alignment than the
natural one, we need to wrap it up in a record type and under-align
the latter. We reuse the padding machinery for this purpose. */
- else if (Present (Alignment_Clause (gnat_entity))
- && UI_Is_In_Int_Range (Alignment (gnat_entity))
- && (align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT)
- && align < TYPE_ALIGN (gnu_type))
+ else if (align > 0)
{
tree gnu_field_type, gnu_field;
/* Set the RM size before wrapping up the type. */
SET_TYPE_RM_SIZE (gnu_type,
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
+
+ /* Create a stripped-down declaration, mainly for debugging. */
+ create_type_decl (gnu_entity_name, gnu_type, NULL, true,
+ debug_info_p, gnat_entity);
+
+ /* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD");
-
- TYPE_ALIGN (gnu_type) = align;
TYPE_PACKED (gnu_type) = 1;
-
- /* Create a stripped-down declaration of the original type, mainly
- for debugging. */
- create_type_decl (gnu_entity_name, gnu_field_type, NULL, true,
- debug_info_p, gnat_entity);
+ TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type);
+ TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type);
+ SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type));
+ TYPE_ALIGN (gnu_type) = align;
+ relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
/* Don't notify the field as "addressable", since we won't be taking
it's address and it would prevent create_field_decl from making a
bitfield. */
- gnu_field = create_field_decl (get_identifier ("OBJECT"),
- gnu_field_type, gnu_type, 1, 0, 0, 0);
-
- finish_record_type (gnu_type, gnu_field, 0, false);
- TYPE_IS_PADDING_P (gnu_type) = 1;
+ gnu_field
+ = create_field_decl (get_identifier ("F"), gnu_field_type,
+ gnu_type, NULL_TREE, bitsize_zero_node, 1, 0);
- relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
+ finish_record_type (gnu_type, gnu_field, 2, debug_info_p);
+ compute_record_mode (gnu_type);
+ TYPE_PADDING_P (gnu_type) = 1;
}
- /* Otherwise reset the alignment lest we computed it above. */
- else
- align = 0;
-
break;
case E_Floating_Point_Type:
tem = chainon (chainon (NULL_TREE,
create_field_decl (get_identifier ("P_ARRAY"),
ptr_void_type_node,
- gnu_fat_type, 0,
- NULL_TREE, NULL_TREE, 0)),
+ gnu_fat_type, NULL_TREE,
+ NULL_TREE, 0, 0)),
create_field_decl (get_identifier ("P_BOUNDS"),
gnu_ptr_template,
- gnu_fat_type, 0,
- NULL_TREE, NULL_TREE, 0));
+ gnu_fat_type, NULL_TREE,
+ NULL_TREE, 0, 0));
/* Make sure we can put this into a register. */
TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
- /* Do not finalize this record type since the types of its fields
- are still incomplete at this point. */
- finish_record_type (gnu_fat_type, tem, 0, true);
- TYPE_IS_FAT_POINTER_P (gnu_fat_type) = 1;
+ /* Do not emit debug info for this record type since the types of its
+ fields are still incomplete at this point. */
+ finish_record_type (gnu_fat_type, tem, 0, false);
+ TYPE_FAT_POINTER_P (gnu_fat_type) = 1;
/* Build a reference to the template from a PLACEHOLDER_EXPR that
is the fat pointer. This will be used to access the individual
char field_name[16];
tree gnu_index_base_type
= get_unpadded_type (Base_Type (Etype (gnat_index)));
- tree gnu_low_field, gnu_high_field, gnu_low, gnu_high, gnu_max;
+ tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
+ tree gnu_min, gnu_max, gnu_high;
/* 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_low_field = create_field_decl (get_identifier (field_name),
- gnu_index_base_type,
- gnu_template_type, 0,
- NULL_TREE, NULL_TREE, 0);
+ gnu_lb_field = create_field_decl (get_identifier (field_name),
+ gnu_index_base_type,
+ gnu_template_type, NULL_TREE,
+ NULL_TREE, 0, 0);
Sloc_to_locus (Sloc (gnat_entity),
- &DECL_SOURCE_LOCATION (gnu_low_field));
+ &DECL_SOURCE_LOCATION (gnu_lb_field));
field_name[0] = 'U';
- gnu_high_field = create_field_decl (get_identifier (field_name),
- gnu_index_base_type,
- gnu_template_type, 0,
- NULL_TREE, NULL_TREE, 0);
+ gnu_hb_field = create_field_decl (get_identifier (field_name),
+ gnu_index_base_type,
+ gnu_template_type, NULL_TREE,
+ NULL_TREE, 0, 0);
Sloc_to_locus (Sloc (gnat_entity),
- &DECL_SOURCE_LOCATION (gnu_high_field));
+ &DECL_SOURCE_LOCATION (gnu_hb_field));
- gnu_temp_fields[index] = chainon (gnu_low_field, gnu_high_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. */
- gnu_low = build3 (COMPONENT_REF, gnu_index_base_type,
- gnu_template_reference, gnu_low_field,
- NULL_TREE);
- gnu_high = build3 (COMPONENT_REF, gnu_index_base_type,
- gnu_template_reference, gnu_high_field,
- NULL_TREE);
- TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1;
-
- /* Compute the size of this dimension. */
- gnu_max
- = build3 (COND_EXPR, gnu_index_base_type,
- build2 (GE_EXPR, integer_type_node, gnu_high, gnu_low),
- gnu_high,
- build2 (MINUS_EXPR, gnu_index_base_type,
- gnu_low, fold_convert (gnu_index_base_type,
- integer_one_node)));
+ gnu_orig_min = build3 (COMPONENT_REF, gnu_index_base_type,
+ gnu_template_reference, gnu_lb_field,
+ NULL_TREE);
+ gnu_orig_max = build3 (COMPONENT_REF, gnu_index_base_type,
+ gnu_template_reference, gnu_hb_field,
+ NULL_TREE);
+ TREE_READONLY (gnu_orig_min) = 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 below for the rationale. */
+ gnu_high
+ = build3 (COND_EXPR, sizetype,
+ build2 (GE_EXPR, boolean_type_node,
+ gnu_orig_max, gnu_orig_min),
+ gnu_max,
+ 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 (convert (sizetype, gnu_low),
- convert (sizetype, gnu_max),
+ = create_index_type (gnu_min, gnu_high,
create_range_type (gnu_index_base_type,
- gnu_low, gnu_high),
+ gnu_orig_min,
+ gnu_orig_max),
gnat_entity);
/* Update the maximum size of the array in elements. */
= chainon (gnu_template_fields, gnu_temp_fields[index]);
/* Install all the fields into the template. */
- finish_record_type (gnu_template_type, gnu_template_fields, 0, false);
+ finish_record_type (gnu_template_type, gnu_template_fields, 0,
+ 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,
+ tem = gnat_to_gnu_component_type (gnat_entity, definition,
debug_info_p);
/* If Component_Size is not already specified, annotate it with the
{
tem = build_array_type (tem, gnu_index_types[index]);
TYPE_MULTI_ARRAY_P (tem) = (index > 0);
- if (array_type_has_nonaliased_component (gnat_entity, tem))
+ if (array_type_has_nonaliased_component (tem, gnat_entity))
TYPE_NONALIASED_COMPONENT (tem) = 1;
}
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
/* If the maximum size doesn't overflow, use it. */
- if (gnu_max_size
+ if (gnu_max_size
&& TREE_CODE (gnu_max_size) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max_size)
&& TREE_CODE (gnu_max_size_unit) == INTEGER_CST
gnu_fat_type, NULL, true,
debug_info_p, gnat_entity);
- /* Create the type to be used as what a thin pointer designates: an
- record type for the object and its template with the field offsets
- shifted to have the template at a negative offset. */
+ /* Create the type to be used as what a thin pointer designates:
+ a record type for the object and its template with the fields
+ shifted to have the template at a negative offset. */
tem = build_unc_object_type (gnu_template_type, tem,
- create_concat_name (gnat_name, "XUT"));
+ create_concat_name (gnat_name, "XUT"),
+ debug_info_p);
shift_unc_components_for_thin_pointers (tem);
SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
gnat_base_index = Next_Index (gnat_base_index))
{
tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
- const int prec_comp
- = compare_tree_int (TYPE_RM_SIZE (gnu_index_type),
- TYPE_PRECISION (sizetype));
- const bool subrange_p = (prec_comp < 0)
- || (prec_comp == 0
- && TYPE_UNSIGNED (gnu_index_type)
- == TYPE_UNSIGNED (sizetype));
- const bool wider_p = (prec_comp > 0);
tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
tree gnu_min = convert (sizetype, gnu_orig_min);
= get_unpadded_type (Etype (gnat_base_index));
tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
- tree gnu_high, gnu_low;
+ tree gnu_high;
/* See if the base array type is already flat. If it is, we
are probably compiling an ACATS test but it will cause the
/* Similarly, if one of the values overflows in sizetype and the
range is null, use 1..0 for the sizetype bounds. */
- else if (!subrange_p
- && TREE_CODE (gnu_min) == INTEGER_CST
+ else if (TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
&& tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
/* If the minimum and maximum values both overflow in sizetype,
but the difference in the original type does not overflow in
sizetype, ignore the overflow indication. */
- else if (!subrange_p
- && TREE_CODE (gnu_min) == INTEGER_CST
+ else if (TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
&& !TREE_OVERFLOW
deal with the "superflat" case. There are three ways to do
this. If we can prove that the array can never be superflat,
we can just use the high bound of the index type. */
- else if (Nkind (gnat_index) == N_Range
- && cannot_be_superflat_p (gnat_index))
+ else if ((Nkind (gnat_index) == N_Range
+ && cannot_be_superflat_p (gnat_index))
+ /* Packed Array Types are never superflat. */
+ || Is_Packed_Array_Type (gnat_entity))
gnu_high = gnu_max;
- /* Otherwise, if we can prove that the low bound minus one and
- the high bound cannot overflow, we can just use the expression
- MAX (hb, lb - 1). Similarly, if we can prove that the high
- bound plus one and the low bound cannot overflow, we can use
- the high bound as-is and MIN (hb + 1, lb) for the low bound.
- Otherwise, we have to fall back to the most general expression
- (hb >= lb) ? hb : lb - 1. Note that the comparison must be
- done in the original index type, to avoid any overflow during
- the conversion. */
- else
+ /* Otherwise, if the high bound is constant but the low bound is
+ not, we use the expression (hb >= lb) ? lb : hb + 1 for the
+ lower bound. Note that the comparison must be done in the
+ original type to avoid any overflow during the conversion. */
+ else if (TREE_CODE (gnu_max) == INTEGER_CST
+ && TREE_CODE (gnu_min) != INTEGER_CST)
{
- gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
- gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node);
-
- /* If gnu_high is a constant that has overflowed, the low
- bound is the smallest integer so cannot be the maximum.
- If gnu_low is a constant that has overflowed, the high
- bound is the highest integer so cannot be the minimum. */
- if ((TREE_CODE (gnu_high) == INTEGER_CST
- && TREE_OVERFLOW (gnu_high))
- || (TREE_CODE (gnu_low) == INTEGER_CST
- && TREE_OVERFLOW (gnu_low)))
- gnu_high = gnu_max;
-
- /* If the index type is a subrange and gnu_high a constant
- that hasn't overflowed, we can use the maximum. */
- else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST)
- gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
-
- /* If the index type is a subrange and gnu_low a constant
- that hasn't overflowed, we can use the minimum. */
- else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST)
- {
- gnu_high = gnu_max;
- gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low);
- }
-
- else
- gnu_high
- = build_cond_expr (sizetype,
- build_binary_op (GE_EXPR,
- integer_type_node,
- gnu_orig_max,
- gnu_orig_min),
- gnu_max, gnu_high);
+ gnu_high = gnu_max;
+ gnu_min
+ = build_cond_expr (sizetype,
+ build_binary_op (GE_EXPR,
+ boolean_type_node,
+ gnu_orig_max,
+ gnu_orig_min),
+ gnu_min,
+ size_binop (PLUS_EXPR, gnu_max,
+ size_one_node));
}
+ /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
+ in all the other cases. Note that, here as well as above,
+ the condition used in the comparison must be equivalent to
+ the condition (length != 0). This is relied upon in order
+ to optimize array comparisons in compare_arrays. */
+ else
+ gnu_high
+ = build_cond_expr (sizetype,
+ build_binary_op (GE_EXPR,
+ boolean_type_node,
+ gnu_orig_max,
+ gnu_orig_min),
+ gnu_max,
+ size_binop (MINUS_EXPR, gnu_min,
+ size_one_node));
+
+ /* Reuse the index type for the range type. Then make an index
+ type with the size range in sizetype. */
gnu_index_types[index]
= create_index_type (gnu_min, gnu_high, gnu_index_type,
gnat_entity);
&& TREE_CODE (TREE_TYPE (gnu_index_type))
!= INTEGER_TYPE)
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
- || wider_p)
+ || compare_tree_int (rm_size (gnu_index_type),
+ TYPE_PRECISION (sizetype)) > 0)
need_index_type_struct = true;
}
{
gnu_type = build_array_type (gnu_type, gnu_index_types[index]);
TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
- if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
+ if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
}
inner dimensions. */
if (global_bindings_p () && ndim > 1)
{
- tree gnu_str_name = get_identifier ("ST");
+ tree gnu_st_name = get_identifier ("ST");
tree gnu_arr_type;
for (gnu_arr_type = TREE_TYPE (gnu_type);
TREE_CODE (gnu_arr_type) == ARRAY_TYPE;
gnu_arr_type = TREE_TYPE (gnu_arr_type),
- gnu_str_name = concat_name (gnu_str_name, "ST"))
+ gnu_st_name = concat_name (gnu_st_name, "ST"))
{
tree eltype = TREE_TYPE (gnu_arr_type);
TYPE_SIZE (gnu_arr_type)
= elaborate_expression_1 (TYPE_SIZE (gnu_arr_type),
- gnat_entity, gnu_str_name,
+ gnat_entity, gnu_st_name,
definition, false);
/* ??? For now, store the size as a multiple of the
alignment of the element type in bytes so that we
can see the alignment from the tree. */
TYPE_SIZE_UNIT (gnu_arr_type)
- = build_binary_op
- (MULT_EXPR, sizetype,
- elaborate_expression_1
- (build_binary_op (EXACT_DIV_EXPR, sizetype,
- TYPE_SIZE_UNIT (gnu_arr_type),
- size_int (TYPE_ALIGN (eltype)
- / BITS_PER_UNIT)),
- gnat_entity, concat_name (gnu_str_name, "A_U"),
- definition, false),
- size_int (TYPE_ALIGN (eltype) / BITS_PER_UNIT));
+ = elaborate_expression_2 (TYPE_SIZE_UNIT (gnu_arr_type),
+ gnat_entity,
+ concat_name (gnu_st_name, "A_U"),
+ definition, false,
+ TYPE_ALIGN (eltype));
/* ??? create_type_decl is not invoked on the inner types so
the MULT_EXPR node built above will never be marked. */
/* Make sure to reference the types themselves, and not just
their names, as the debugger may fall back on them. */
gnu_field = create_field_decl (gnu_index_name, gnu_index,
- gnu_bound_rec,
- 0, NULL_TREE, NULL_TREE, 0);
+ gnu_bound_rec, NULL_TREE,
+ NULL_TREE, 0, 0);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
}
- finish_record_type (gnu_bound_rec, gnu_field_list, 0, false);
+ finish_record_type (gnu_bound_rec, gnu_field_list, 0, true);
add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
}
gnu_inner = gnu_type;
while (TREE_CODE (gnu_inner) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_inner)
- || TYPE_IS_PADDING_P (gnu_inner)))
+ || TYPE_PADDING_P (gnu_inner)))
gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner));
/* We need to attach the index type to the type we just made so
gnu_type
= build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
gnu_index_type);
- if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
+ if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY);
}
Present (gnat_field);
gnat_field = Next_Stored_Discriminant (gnat_field))
if (Present (Corresponding_Discriminant (gnat_field)))
- save_gnu_tree
- (gnat_field,
- build3 (COMPONENT_REF,
- get_unpadded_type (Etype (gnat_field)),
- gnu_get_parent,
- gnat_to_gnu_field_decl (Corresponding_Discriminant
- (gnat_field)),
- NULL_TREE),
- true);
+ {
+ tree gnu_field
+ = gnat_to_gnu_field_decl (Corresponding_Discriminant
+ (gnat_field));
+ save_gnu_tree
+ (gnat_field,
+ build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
+ gnu_get_parent, gnu_field, NULL_TREE),
+ true);
+ }
/* Then we build the parent subtype. If it has discriminants but
the type itself has unknown discriminants, this means that it
/* ...and reference the _Parent field of this record. */
gnu_field
- = create_field_decl (get_identifier
- (Get_Name_String (Name_uParent)),
- gnu_parent, gnu_type, 0,
+ = create_field_decl (parent_name_id,
+ gnu_parent, gnu_type,
has_rep
? TYPE_SIZE (gnu_parent) : NULL_TREE,
has_rep
- ? bitsize_zero_node : NULL_TREE, 1);
+ ? bitsize_zero_node : NULL_TREE,
+ 0, 1);
DECL_INTERNAL_P (gnu_field) = 1;
TREE_OPERAND (gnu_get_parent, 1) = gnu_field;
TYPE_FIELDS (gnu_type) = gnu_field;
/* 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, NULL,
- false, all_rep, false, is_unchecked_union,
- debug_info_p);
+ false, all_rep, is_unchecked_union,
+ debug_info_p, false);
- /* 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))
+ /* 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))
SET_TYPE_MODE (gnu_type, BLKmode);
/* We used to remove the associations of the discriminants and _Parent
copy_and_substitute_in_size (gnu_type, gnu_base_type,
gnu_subst_list);
- if (TREE_CODE (gnu_base_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_base_type))
+ if (TYPE_IS_PADDING_P (gnu_base_type))
gnu_unpad_base_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type));
else
gnu_unpad_base_type = gnu_base_type;
{
gnu_size = DECL_SIZE (gnu_old_field);
if (TREE_CODE (gnu_field_type) == RECORD_TYPE
- && !TYPE_IS_FAT_POINTER_P (gnu_field_type)
+ && !TYPE_FAT_POINTER_P (gnu_field_type)
&& host_integerp (TYPE_SIZE (gnu_field_type), 1))
gnu_field_type
= make_packable_type (gnu_field_type, true);
&& !present_gnu_tree (Etype (gnat_field)))
gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
- /* Do not finalize it since we're going to modify it below. */
+ /* Do not emit debug info for the type yet since we're going to
+ modify it below. */
gnu_field_list = nreverse (gnu_field_list);
- finish_record_type (gnu_type, gnu_field_list, 2, true);
+ finish_record_type (gnu_type, gnu_field_list, 2, false);
/* See the E_Record_Type case for the rationale. */
- if (Is_Tagged_Type (gnat_entity)
- || Is_Limited_Record (gnat_entity))
+ if (Is_By_Reference_Type (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
else
compute_record_mode (gnu_type);
/* Fill in locations of fields. */
annotate_rep (gnat_entity, gnu_type);
- /* We've built a new type, make an XVS type to show what this
- is a subtype of. Some debuggers require the XVS type to be
- output first, so do it in that order. */
+ /* If debugging information is being written for the type, write
+ a record that shows what we are a subtype of and also make a
+ variable that indicates our size, if still variable. */
if (debug_info_p)
{
tree gnu_subtype_marker = make_node (RECORD_TYPE);
tree gnu_unpad_base_name = TYPE_NAME (gnu_unpad_base_type);
+ tree gnu_size_unit = TYPE_SIZE_UNIT (gnu_type);
if (TREE_CODE (gnu_unpad_base_name) == TYPE_DECL)
gnu_unpad_base_name = DECL_NAME (gnu_unpad_base_name);
build_reference_type
(gnu_unpad_base_type),
gnu_subtype_marker,
- 0, NULL_TREE,
- NULL_TREE, 0),
- 0, false);
+ NULL_TREE, NULL_TREE,
+ 0, 0),
+ 0, true);
add_parallel_type (TYPE_STUB_DECL (gnu_type),
gnu_subtype_marker);
+
+ if (definition
+ && TREE_CODE (gnu_size_unit) != INTEGER_CST
+ && !CONTAINS_PLACEHOLDER_P (gnu_size_unit))
+ TYPE_SIZE_UNIT (gnu_subtype_marker)
+ = create_var_decl (create_concat_name (gnat_entity,
+ "XVZ"),
+ NULL_TREE, sizetype, gnu_size_unit,
+ false, false, false, false, NULL,
+ gnat_entity);
}
/* Now we can finalize it. */
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
(get_identifier ("P_ARRAY"),
- gnu_ptr_array,
- gnu_type, 0, 0, 0, 0)),
+ gnu_ptr_array, gnu_type,
+ NULL_TREE, NULL_TREE, 0, 0)),
create_field_decl (get_identifier ("P_BOUNDS"),
- gnu_ptr_template,
- gnu_type, 0, 0, 0, 0));
+ gnu_ptr_template, gnu_type,
+ NULL_TREE, NULL_TREE, 0, 0));
/* Make sure we can place this into a register. */
TYPE_ALIGN (gnu_type)
= MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
- TYPE_IS_FAT_POINTER_P (gnu_type) = 1;
+ TYPE_FAT_POINTER_P (gnu_type) = 1;
- /* Do not finalize this record type since the types of
- its fields are incomplete. */
- finish_record_type (gnu_type, fields, 0, true);
+ /* Do not emit debug info for this record type since the types
+ of its fields are incomplete. */
+ finish_record_type (gnu_type, fields, 0, false);
TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE);
TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old))
if ((! in_main_unit || is_from_limited_with) && made_dummy)
{
tree gnu_old_type
- = TYPE_FAT_POINTER_P (gnu_type)
+ = TYPE_IS_FAT_POINTER_P (gnu_type)
? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
if (esize == POINTER_SIZE
- && (got_fat_p || TYPE_FAT_POINTER_P (gnu_type)))
+ && (got_fat_p || TYPE_IS_FAT_POINTER_P (gnu_type)))
gnu_type
= build_pointer_type
(TYPE_OBJECT_RECORD_TYPE
tree gnu_field_list = NULL_TREE;
/* Non-null for subprograms containing parameters passed by copy-in
copy-out (Ada In Out or Out parameters not passed by reference),
- in which case it is the list of nodes used to specify the values of
- the in out/out parameters that are returned as a record upon
+ in which case it is the list of nodes used to specify the values
+ of the In Out/Out parameters that are returned as a record upon
procedure return. The TREE_PURPOSE of an element of this list is
a field of the record and the TREE_VALUE is the PARM_DECL
corresponding to that field. This list will be saved in the
TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */
- tree gnu_return_list = NULL_TREE;
+ tree gnu_cico_list = NULL_TREE;
/* If an import pragma asks to map this subprogram to a GCC builtin,
this is the builtin DECL node. */
tree gnu_builtin_decl = NULL_TREE;
&& Is_Pure (gnat_entity));
bool volatile_flag = No_Return (gnat_entity);
- bool returns_by_ref = false;
- bool returns_unconstrained = false;
- bool returns_by_target_ptr = false;
+ bool return_by_direct_ref_p = false;
+ bool return_by_invisi_ref_p = false;
+ bool return_unconstrained_p = false;
bool has_copy_in_out = false;
bool has_stub = false;
int parmnum;
if (kind == E_Function || kind == E_Subprogram_Type)
gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
- /* If this function returns by reference, make the actual
- return type of this function the pointer and mark the decl. */
+ /* If this function returns by reference, make the actual return
+ type of this function the pointer and mark the decl. */
if (Returns_By_Ref (gnat_entity))
{
- returns_by_ref = true;
gnu_return_type = build_pointer_type (gnu_return_type);
+ return_by_direct_ref_p = true;
}
- /* If the Mechanism is By_Reference, ensure the return type uses
- the machine's by-reference mechanism, which may not the same
- as above (e.g., it might be by passing a fake parameter). */
- else if (kind == E_Function
- && Mechanism (gnat_entity) == By_Reference)
- {
- TREE_ADDRESSABLE (gnu_return_type) = 1;
-
- /* We expect this bit to be reset by gigi shortly, so can avoid a
- type node copy here. This actually also prevents troubles with
- the generation of debug information for the function, because
- we might have issued such info for this type already, and would
- be attaching a distinct type node to the function if we made a
- copy here. */
- }
-
- /* If we are supposed to return an unconstrained array,
- actually return a fat pointer and make a note of that. Return
- a pointer to an unconstrained record of variable size. */
+ /* If the Mechanism is By_Reference, ensure this function uses the
+ target's by-invisible-reference mechanism, which may not be the
+ same as above (e.g. it might be passing an extra parameter).
+
+ Prior to GCC 4, this was handled by just setting TREE_ADDRESSABLE
+ on the result type. Everything required to pass by invisible
+ reference using the target's mechanism (e.g. an extra parameter)
+ was handled at RTL expansion time.
+
+ This doesn't work with GCC 4 any more for several reasons. First,
+ the gimplification process might need to create temporaries of this
+ type and the gimplifier ICEs on such attempts; that's why the flag
+ is now set on the function type instead. Second, the middle-end
+ now also relies on a different attribute, DECL_BY_REFERENCE on the
+ RESULT_DECL, and expects the by-invisible-reference-ness to be made
+ explicit in the function body. */
+ else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference)
+ return_by_invisi_ref_p = true;
+
+ /* If we are supposed to return an unconstrained array, actually return
+ a fat pointer and make a note of that. */
else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
{
gnu_return_type = TREE_TYPE (gnu_return_type);
- returns_unconstrained = true;
+ return_unconstrained_p = true;
}
/* If the type requires a transient scope, the result is allocated
else if (Requires_Transient_Scope (Etype (gnat_entity)))
{
gnu_return_type = build_pointer_type (gnu_return_type);
- returns_unconstrained = true;
+ return_unconstrained_p = true;
}
/* If the type is a padded type and the underlying type would not
be passed by reference or this function has a foreign convention,
return the underlying type. */
- else if (TREE_CODE (gnu_return_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_return_type)
+ else if (TYPE_IS_PADDING_P (gnu_return_type)
&& (!default_pass_by_ref (TREE_TYPE
(TYPE_FIELDS (gnu_return_type)))
|| Has_Foreign_Convention (gnat_entity)))
gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
- /* If the return type has a non-constant size, we convert the function
- into a procedure and its caller will pass a pointer to an object as
- the first parameter when we call the function. This can happen for
- an unconstrained type with a maximum size or a constrained type with
- a size not known at compile time. */
- if (TYPE_SIZE_UNIT (gnu_return_type)
- && !TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type)))
+ /* If the return type is unconstrained, that means it must have a
+ maximum size. Use the padded type as the effective return type.
+ And ensure the function uses the target's by-invisible-reference
+ mechanism to avoid copying too much data when it returns. */
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
{
- returns_by_target_ptr = true;
- gnu_param_list
- = create_param_decl (get_identifier ("TARGET"),
- build_reference_type (gnu_return_type),
- true);
- gnu_return_type = void_type_node;
+ gnu_return_type
+ = maybe_pad_type (gnu_return_type,
+ max_size (TYPE_SIZE (gnu_return_type), true),
+ 0, gnat_entity, false, false, false, true);
+ return_by_invisi_ref_p = true;
}
/* If the return type has a size that overflows, we cannot have
between two calls, so they can't be CSE'ed. The latter
case also handles by-ref parameters. */
if (POINTER_TYPE_P (gnu_param_type)
- || TYPE_FAT_POINTER_P (gnu_param_type))
+ || TYPE_IS_FAT_POINTER_P (gnu_param_type))
const_flag = false;
}
gcc_assert (TREE_CODE (gnu_return_type) == VOID_TYPE);
gnu_return_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
+ /* Set a default alignment to speed up accesses. */
+ TYPE_ALIGN (gnu_return_type)
+ = get_mode_alignment (ptr_mode);
has_copy_in_out = true;
}
- gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
- gnu_return_type, 0, 0, 0, 0);
+ gnu_field
+ = create_field_decl (gnu_param_name, gnu_param_type,
+ gnu_return_type, NULL_TREE, NULL_TREE,
+ 0, 0);
Sloc_to_locus (Sloc (gnat_param),
&DECL_SOURCE_LOCATION (gnu_field));
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
- gnu_return_list = tree_cons (gnu_field, gnu_param,
- gnu_return_list);
+ gnu_cico_list
+ = tree_cons (gnu_field, gnu_param, gnu_cico_list);
}
}
stubbed since structures are incomplete for the back-end. */
if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed)
finish_record_type (gnu_return_type, nreverse (gnu_field_list),
- 0, false);
+ 0, debug_info_p);
/* If we have a CICO list but it has only one entry, we convert
this function into a function that simply returns that one
object. */
- if (list_length (gnu_return_list) == 1)
- gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
+ if (list_length (gnu_cico_list) == 1)
+ gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list));
if (Has_Stdcall_Convention (gnat_entity))
prepend_one_attribute_to
gnu_param_list = nreverse (gnu_param_list);
if (has_stub)
gnu_stub_param_list = nreverse (gnu_stub_param_list);
- gnu_return_list = nreverse (gnu_return_list);
+ gnu_cico_list = nreverse (gnu_cico_list);
if (Ekind (gnat_entity) == E_Function)
- Set_Mechanism (gnat_entity,
- (returns_by_ref || returns_unconstrained
- ? By_Reference : By_Copy));
+ Set_Mechanism (gnat_entity, return_unconstrained_p
+ || return_by_direct_ref_p
+ || return_by_invisi_ref_p
+ ? By_Reference : By_Copy);
gnu_type
= create_subprog_type (gnu_return_type, gnu_param_list,
- gnu_return_list, returns_unconstrained,
- returns_by_ref, returns_by_target_ptr);
+ gnu_cico_list, return_unconstrained_p,
+ return_by_direct_ref_p,
+ return_by_invisi_ref_p);
if (has_stub)
gnu_stub_type
= create_subprog_type (gnu_return_type, gnu_stub_param_list,
- gnu_return_list, returns_unconstrained,
- returns_by_ref, returns_by_target_ptr);
+ gnu_cico_list, return_unconstrained_p,
+ return_by_direct_ref_p,
+ return_by_invisi_ref_p);
/* A subprogram (something that doesn't return anything) shouldn't
be considered const since there would be no reason for such a
| (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 (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
- TYPE_BY_REFERENCE_P (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;
/* ??? 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
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (gnu_type))
+ && !TYPE_FAT_POINTER_P (gnu_type))
size = rm_size (gnu_type);
else
size = TYPE_SIZE (gnu_type);
us when we make the new TYPE_DECL below. */
if (gnu_size || align > 0)
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- "PAD", true, definition, false);
+ false, !gnu_decl, definition, false);
- if (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type))
+ if (TYPE_IS_PADDING_P (gnu_type))
{
gnu_entity_name = TYPE_NAME (gnu_type);
if (TREE_CODE (gnu_entity_name) == TYPE_DECL)
&& !TREE_CONSTANT (TYPE_SIZE (gnu_type))
&& !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
{
- if (TREE_CODE (gnu_type) == RECORD_TYPE
- && operand_equal_p (TYPE_ADA_SIZE (gnu_type),
- TYPE_SIZE (gnu_type), 0))
- {
- TYPE_SIZE (gnu_type)
- = elaborate_expression_1 (TYPE_SIZE (gnu_type),
- gnat_entity, get_identifier ("SIZE"),
- definition, false);
- SET_TYPE_ADA_SIZE (gnu_type, TYPE_SIZE (gnu_type));
- }
- else
+ tree size = TYPE_SIZE (gnu_type);
+
+ TYPE_SIZE (gnu_type)
+ = elaborate_expression_1 (size, gnat_entity,
+ get_identifier ("SIZE"),
+ definition, false);
+
+ /* ??? For now, store the size as a multiple of the alignment in
+ bytes so that we can see the alignment from the tree. */
+ TYPE_SIZE_UNIT (gnu_type)
+ = elaborate_expression_2 (TYPE_SIZE_UNIT (gnu_type), gnat_entity,
+ get_identifier ("SIZE_A_UNIT"),
+ definition, false,
+ TYPE_ALIGN (gnu_type));
+
+ /* ??? gnu_type may come from an existing type so the MULT_EXPR node
+ may not be marked by the call to create_type_decl below. */
+ MARK_VISITED (TYPE_SIZE_UNIT (gnu_type));
+
+ if (TREE_CODE (gnu_type) == RECORD_TYPE)
{
- TYPE_SIZE (gnu_type)
- = elaborate_expression_1 (TYPE_SIZE (gnu_type),
- gnat_entity, get_identifier ("SIZE"),
- definition, false);
+ tree variant_part = get_variant_part (gnu_type);
+ tree ada_size = TYPE_ADA_SIZE (gnu_type);
- /* ??? For now, store the size as a multiple of the alignment
- in bytes so that we can see the alignment from the tree. */
- TYPE_SIZE_UNIT (gnu_type)
- = build_binary_op
- (MULT_EXPR, sizetype,
- elaborate_expression_1
- (build_binary_op (EXACT_DIV_EXPR, sizetype,
- TYPE_SIZE_UNIT (gnu_type),
- size_int (TYPE_ALIGN (gnu_type)
- / BITS_PER_UNIT)),
- gnat_entity, get_identifier ("SIZE_A_UNIT"),
- definition, false),
- size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
-
- if (TREE_CODE (gnu_type) == RECORD_TYPE)
- SET_TYPE_ADA_SIZE
- (gnu_type,
- elaborate_expression_1 (TYPE_ADA_SIZE (gnu_type),
- gnat_entity,
- get_identifier ("RM_SIZE"),
- definition, false));
- }
+ if (variant_part)
+ {
+ tree union_type = TREE_TYPE (variant_part);
+ tree offset = DECL_FIELD_OFFSET (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 reduces the data size. */
+ if (TREE_CODE (offset) == INTEGER_CST)
+ {
+ tree bitpos = DECL_FIELD_BIT_OFFSET (variant_part);
+ TYPE_SIZE (union_type)
+ = size_binop (MINUS_EXPR, TYPE_SIZE (gnu_type),
+ bit_from_pos (offset, bitpos));
+ TYPE_SIZE_UNIT (union_type)
+ = size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (gnu_type),
+ byte_from_pos (offset, bitpos));
+ }
+ else
+ {
+ TYPE_SIZE (union_type)
+ = elaborate_expression_1 (TYPE_SIZE (union_type),
+ gnat_entity,
+ get_identifier ("VSIZE"),
+ definition, false);
+
+ /* ??? For now, store the size as a multiple of the
+ alignment in bytes so that we can see the alignment
+ from the tree. */
+ TYPE_SIZE_UNIT (union_type)
+ = elaborate_expression_2 (TYPE_SIZE_UNIT (union_type),
+ gnat_entity,
+ get_identifier
+ ("VSIZE_A_UNIT"),
+ definition, false,
+ TYPE_ALIGN (union_type));
+
+ /* ??? For now, store the offset as a multiple of the
+ alignment in bytes so that we can see the alignment
+ from the tree. */
+ DECL_FIELD_OFFSET (variant_part)
+ = elaborate_expression_2 (offset,
+ gnat_entity,
+ get_identifier ("VOFFSET"),
+ definition, false,
+ DECL_OFFSET_ALIGN
+ (variant_part));
+ }
+
+ DECL_SIZE (variant_part) = TYPE_SIZE (union_type);
+ DECL_SIZE_UNIT (variant_part) = TYPE_SIZE_UNIT (union_type);
+ }
+
+ if (operand_equal_p (ada_size, size, 0))
+ ada_size = TYPE_SIZE (gnu_type);
+ else
+ ada_size
+ = elaborate_expression_1 (ada_size, gnat_entity,
+ get_identifier ("RM_SIZE"),
+ definition, false);
+ SET_TYPE_ADA_SIZE (gnu_type, ada_size);
+ }
}
/* If this is a record type or subtype, call elaborate_expression_1 on
{
tree gnu_field = get_gnu_tree (gnat_temp);
- /* ??? Unfortunately, GCC needs to be able to prove the
- alignment of this offset and if it's a variable, it can't.
- In GCC 3.4, we'll use DECL_OFFSET_ALIGN in some way, but
- right now, we have to put in an explicit multiply and
- divide by that value. */
+ /* ??? For now, store the offset as a multiple of the alignment
+ in bytes so that we can see the alignment from the tree. */
if (!CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (gnu_field)))
{
- DECL_FIELD_OFFSET (gnu_field)
- = build_binary_op
- (MULT_EXPR, sizetype,
- elaborate_expression_1
- (build_binary_op (EXACT_DIV_EXPR, sizetype,
- DECL_FIELD_OFFSET (gnu_field),
- size_int (DECL_OFFSET_ALIGN (gnu_field)
- / BITS_PER_UNIT)),
- gnat_temp, get_identifier ("OFFSET"),
- definition, false),
- size_int (DECL_OFFSET_ALIGN (gnu_field) / BITS_PER_UNIT));
-
- /* ??? The context of gnu_field is not necessarily gnu_type so
- the MULT_EXPR node built above may not be marked by the call
- to create_type_decl below. */
- if (global_bindings_p ())
- MARK_VISITED (DECL_FIELD_OFFSET (gnu_field));
+ DECL_FIELD_OFFSET (gnu_field)
+ = elaborate_expression_2 (DECL_FIELD_OFFSET (gnu_field),
+ gnat_temp,
+ get_identifier ("OFFSET"),
+ definition, false,
+ DECL_OFFSET_ALIGN (gnu_field));
+
+ /* ??? The context of gnu_field is not necessarily gnu_type
+ so the MULT_EXPR node built above may not be marked by
+ the call to create_type_decl below. */
+ if (global_bindings_p ())
+ MARK_VISITED (DECL_FIELD_OFFSET (gnu_field));
}
}
!Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
else
- TREE_TYPE (gnu_decl) = gnu_type;
+ {
+ TREE_TYPE (gnu_decl) = gnu_type;
+ TYPE_STUB_DECL (gnu_type) = gnu_decl;
+ }
}
if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
superset superset
R ----------> D ----------> T
+ However, for composite types, conversions between derived types are
+ translated into VIEW_CONVERT_EXPRs so a sequence like:
+
+ type Comp1 is new Comp;
+ type Comp2 is new Comp;
+ procedure Proc (C : Comp1);
+
+ C : Comp2;
+ Proc (Comp1 (C));
+
+ is translated into:
+
+ C : Comp2;
+ Proc ((Comp1 &) &VIEW_CONVERT_EXPR <Comp1> (C));
+
+ and gimplified into:
+
+ C : Comp2;
+ Comp1 *C.0;
+ C.0 = (Comp1 *) &C;
+ Proc (C.0);
+
+ i.e. generates code involving type punning. Therefore, Comp1 needs
+ to conflict with Comp2 and an alias set copy is required.
+
The language rules ensure the parent type is already frozen here. */
if (Is_Derived_Type (gnat_entity))
{
tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity));
- relate_alias_sets (gnu_type, gnu_parent_type, ALIAS_SET_SUPERSET);
+ relate_alias_sets (gnu_type, gnu_parent_type,
+ Is_Composite_Type (gnat_entity)
+ ? ALIAS_SET_COPY : ALIAS_SET_SUPERSET);
}
/* Back-annotate the Alignment of the type if not already in the
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
- explicitly now. */
- int size_offset, new_size;
+ /* 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;
if (Is_Derived_Type (gnat_entity))
{
- size_offset
- = UI_To_Int (Esize (Etype (Base_Type (gnat_entity))));
+ offset = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
+ bitsizetype);
Set_Alignment (gnat_entity,
Alignment (Etype (Base_Type (gnat_entity))));
}
else
- 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));
+ 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);
}
+ else
+ Set_Esize (gnat_entity, annotate_value (gnu_size));
}
if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type))
tree gnu_low_bound, gnu_high_bound;
/* If this is a padded type, we need to use the underlying type. */
- if (TREE_CODE (gnu_scalar_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_scalar_type))
+ if (TYPE_IS_PADDING_P (gnu_scalar_type))
gnu_scalar_type = TREE_TYPE (TYPE_FIELDS (gnu_scalar_type));
/* If this is a floating point type and we haven't set a floating
{
tree type = gnat_to_gnu_type (gnat_entity);
- if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+ if (TYPE_IS_PADDING_P (type))
type = TREE_TYPE (TYPE_FIELDS (type));
return type;
break;
case E_Class_Wide_Type:
- gnat_equiv = ((Present (Equivalent_Type (gnat_entity)))
- ? Equivalent_Type (gnat_entity)
- : Root_Type (gnat_entity));
+ gnat_equiv = Root_Type (gnat_entity);
break;
case E_Task_Type:
&& !Has_Aliased_Components (gnat_array)
&& !Strict_Alignment (Component_Type (gnat_array))
&& TREE_CODE (gnu_type) == RECORD_TYPE
- && !TYPE_IS_FAT_POINTER_P (gnu_type)
+ && !TYPE_FAT_POINTER_P (gnu_type)
&& host_integerp (TYPE_SIZE (gnu_type), 1))
gnu_type = make_packable_type (gnu_type, false);
Is_Bit_Packed_Array (gnat_array) ? TYPE_DECL : VAR_DECL,
true, Has_Component_Size_Clause (gnat_array));
+ /* If the array has aliased components and the component size can be zero,
+ force at least unit size to ensure that the components have distinct
+ addresses. */
+ if (!gnu_comp_size
+ && Has_Aliased_Components (gnat_array)
+ && (integer_zerop (TYPE_SIZE (gnu_type))
+ || (TREE_CODE (gnu_type) == ARRAY_TYPE
+ && !TREE_CONSTANT (TYPE_SIZE (gnu_type)))))
+ gnu_comp_size
+ = size_binop (MAX_EXPR, TYPE_SIZE (gnu_type), bitsize_unit_node);
+
/* If the component type is a RECORD_TYPE that has a self-referential size,
then use the maximum size for the component size. */
if (!gnu_comp_size
orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_array,
- "C_PAD", false, definition, true);
+ true, false, definition, true);
/* If a padding record was made, declare it now since it will never be
declared otherwise. This is necessary to ensure that its subtrees
/* If this is either a foreign function or if the underlying type won't
be passed by reference, strip off possible padding type. */
- if (TREE_CODE (gnu_param_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_param_type))
+ if (TYPE_IS_PADDING_P (gnu_param_type))
{
tree unpadded_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type));
}
/* Fat pointers are passed as thin pointers for foreign conventions. */
- else if (foreign && TYPE_FAT_POINTER_P (gnu_param_type))
+ else if (foreign && TYPE_IS_FAT_POINTER_P (gnu_param_type))
gnu_param_type
= make_type_from_size (gnu_param_type, size_int (POINTER_SIZE), 0);
Original_Record_Component (discr1) == Original_Record_Component (discr2);
}
-/* Return true if the array type specified by GNAT_TYPE and GNU_TYPE has
- a non-aliased component in the back-end sense. */
+/* Return true if the array type GNU_TYPE, which represents a dimension of
+ GNAT_TYPE, has a non-aliased component in the back-end sense. */
static bool
-array_type_has_nonaliased_component (Entity_Id gnat_type, tree gnu_type)
+array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type)
{
- /* If the type below this is a multi-array type, then
- this does not have aliased components. */
+ /* If the array type is not the innermost dimension of the GNAT type,
+ then it has a non-aliased component. */
if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
return true;
+ /* If the array type has an aliased component in the front-end sense,
+ then it also has an aliased component in the back-end sense. */
if (Has_Aliased_Components (gnat_type))
return false;
+ /* If this is a derived type, then it has a non-aliased component if
+ and only if its parent type also has one. */
+ if (Is_Derived_Type (gnat_type))
+ {
+ tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_type));
+ int index;
+ if (TREE_CODE (gnu_parent_type) == UNCONSTRAINED_ARRAY_TYPE)
+ gnu_parent_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_parent_type))));
+ for (index = Number_Dimensions (gnat_type) - 1; index > 0; index--)
+ gnu_parent_type = TREE_TYPE (gnu_parent_type);
+ return TYPE_NONALIASED_COMPONENT (gnu_parent_type);
+ }
+
+ /* Otherwise, rely exclusively on properties of the element type. */
return type_for_nonaliased_component_p (TREE_TYPE (gnu_type));
}
return Compile_Time_Known_Value (gnat_address);
}
-/* 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. */
+/* 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. */
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;
+ tree gnu_lb, gnu_hb, gnu_lb_minus_one;
/* If the low bound is not constant, try to find an upper bound. */
while (Nkind (gnat_lb) != N_Integer_Literal
|| Nkind (scalar_range) == N_Range))
gnat_hb = Low_Bound (scalar_range);
- if (!(Nkind (gnat_lb) == N_Integer_Literal
- && Nkind (gnat_hb) == N_Integer_Literal))
+ /* If we have failed to find constant bounds, punt. */
+ if (Nkind (gnat_lb) != N_Integer_Literal
+ || Nkind (gnat_hb) != N_Integer_Literal)
return false;
- gnu_lb = UI_To_gnu (Intval (gnat_lb), bitsizetype);
- gnu_hb = UI_To_gnu (Intval (gnat_hb), bitsizetype);
+ /* We need at least a signed 64-bit type to catch most cases. */
+ gnu_lb = UI_To_gnu (Intval (gnat_lb), sbitsizetype);
+ gnu_hb = UI_To_gnu (Intval (gnat_hb), sbitsizetype);
+ if (TREE_OVERFLOW (gnu_lb) || TREE_OVERFLOW (gnu_hb))
+ return false;
/* If the low bound is the smallest integer, nothing can be smaller. */
- gnu_lb = size_binop (MINUS_EXPR, gnu_lb, bitsize_one_node);
- if (TREE_OVERFLOW (gnu_lb))
+ gnu_lb_minus_one = size_binop (MINUS_EXPR, gnu_lb, sbitsize_one_node);
+ if (TREE_OVERFLOW (gnu_lb_minus_one))
return true;
- return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0);
+ return !tree_int_cst_lt (gnu_hb, gnu_lb_minus_one);
+}
+
+/* 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
see the inner types. */
while (TREE_CODE (gnu_old_type) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type)
- || TYPE_IS_PADDING_P (gnu_old_type)))
+ || TYPE_PADDING_P (gnu_old_type)))
gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
/* Unconstrained array types are deemed incomplete and would thus be given
}
}
\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 ? maybe_variable (gnu_expr) : gnu_expr;
+ return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
+}
+
+/* Similar, but take an alignment factor and make it explicit in the tree. */
+
+static tree
+elaborate_expression_2 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
+ bool definition, bool need_debug, unsigned int align)
+{
+ tree unit_align = size_int (align / BITS_PER_UNIT);
+ return
+ size_binop (MULT_EXPR,
+ elaborate_expression_1 (size_binop (EXACT_DIV_EXPR,
+ gnu_expr,
+ unit_align),
+ gnat_entity, gnu_name, definition,
+ need_debug),
+ unit_align);
}
\f
/* Create a record type that contains a SIZE bytes long field of TYPE with a
/* We will be crafting a record type with one field at a position set to be
the next multiple of ALIGN past record'address + room bytes. We use a
record placeholder to express record'address. */
-
tree record_type = make_node (RECORD_TYPE);
tree record = build0 (PLACEHOLDER_EXPR, record_type);
Every length is in sizetype bytes there, except "pos" which has to be
set as a bit position in the GCC tree for the record. */
-
tree room_st = size_int (room);
tree vblock_addr_st = size_binop (PLUS_EXPR, record_addr_st, room_st);
tree voffset_st, pos, field;
/* Compute VOFFSET and then POS. The next byte position multiple of some
alignment after some address is obtained by "and"ing the alignment minus
1 with the two's complement of the address. */
-
voffset_st = size_binop (BIT_AND_EXPR,
- size_diffop (size_zero_node, vblock_addr_st),
- ssize_int ((align / BITS_PER_UNIT) - 1));
+ fold_build1 (NEGATE_EXPR, sizetype, vblock_addr_st),
+ size_int ((align / BITS_PER_UNIT) - 1));
/* POS = (ROOM + VOFFSET) * BIT_PER_UNIT, in bitsizetype. */
-
pos = size_binop (MULT_EXPR,
convert (bitsizetype,
size_binop (PLUS_EXPR, room_st, voffset_st)),
consequences on the alignment computation, and create_field_decl would
make one without this special argument, for instance because of the
complex position expression. */
-
- field = create_field_decl (get_identifier ("F"), type, record_type,
- 1, size, pos, -1);
+ field = create_field_decl (get_identifier ("F"), type, record_type, size,
+ pos, 1, -1);
TYPE_FIELDS (record_type) = field;
TYPE_ALIGN (record_type) = base_align;
TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
if (TREE_CODE (type) == RECORD_TYPE)
- TYPE_IS_PADDING_P (new_type) = TYPE_IS_PADDING_P (type);
+ TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type);
/* If we are in a record and have a small size, set the alignment to
try for an integral mode. Otherwise set it to try for a smaller
if ((TREE_CODE (new_field_type) == RECORD_TYPE
|| TREE_CODE (new_field_type) == UNION_TYPE
|| TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_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);
&& (TREE_CODE (new_field_type) == RECORD_TYPE
|| TREE_CODE (new_field_type) == UNION_TYPE
|| TREE_CODE (new_field_type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (new_field_type)
+ && !TYPE_FAT_POINTER_P (new_field_type)
&& !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
&& TYPE_ADA_SIZE (new_field_type))
new_size = TYPE_ADA_SIZE (new_field_type);
else
new_size = DECL_SIZE (old_field);
- new_field = create_field_decl (DECL_NAME (old_field), new_field_type,
- new_type, TYPE_PACKED (type), new_size,
- bit_position (old_field),
- !DECL_NONADDRESSABLE_P (old_field));
+ new_field
+ = create_field_decl (DECL_NAME (old_field), new_field_type, new_type,
+ new_size, bit_position (old_field),
+ TYPE_PACKED (type),
+ !DECL_NONADDRESSABLE_P (old_field));
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- SET_DECL_ORIGINAL_FIELD
- (new_field, (DECL_ORIGINAL_FIELD (old_field)
- ? DECL_ORIGINAL_FIELD (old_field) : old_field));
-
+ SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
field_list = new_field;
}
- finish_record_type (new_type, nreverse (field_list), 2, true);
+ finish_record_type (new_type, nreverse (field_list), 2, false);
relate_alias_sets (new_type, type, ALIAS_SET_COPY);
/* If this is a padding record, we never want to make the size smaller
than what was specified. For QUAL_UNION_TYPE, also copy the size. */
- if ((TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
- || TREE_CODE (type) == QUAL_UNION_TYPE)
+ if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
{
TYPE_SIZE (new_type) = TYPE_SIZE (type);
TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
+ new_size = size;
}
else
{
\f
/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
if needed. We have already verified that SIZE and TYPE are large enough.
-
- GNAT_ENTITY and NAME_TRAILER are used to name the resulting record and
- to issue a warning.
-
- IS_USER_TYPE is true if we must complete the original type.
-
- DEFINITION is true if this type is being defined.
-
- SAME_RM_SIZE is true if the RM size of the resulting type is to be set
- to SIZE too; otherwise, it's set to the RM size of the original type. */
+ GNAT_ENTITY is used to name the resulting record and to issue a warning.
+ IS_COMPONENT_TYPE is true if this is being done for the component type
+ of an array. IS_USER_TYPE is true if we must complete the original type.
+ DEFINITION is true if this type is being defined. SAME_RM_SIZE is true
+ if the RM size of the resulting type is to be set to SIZE too; otherwise,
+ it's set to the RM size of the original type. */
tree
maybe_pad_type (tree type, tree size, unsigned int align,
- Entity_Id gnat_entity, const char *name_trailer,
+ Entity_Id gnat_entity, bool is_component_type,
bool is_user_type, bool definition, bool same_rm_size)
{
tree orig_rm_size = same_rm_size ? NULL_TREE : rm_size (type);
tree orig_size = TYPE_SIZE (type);
- unsigned int orig_align = align;
tree record, field;
/* If TYPE is a padded type, see if it agrees with any size and alignment
off the padding, since we will either be returning the inner type
or repadding it. If no size or alignment is specified, use that of
the original padded type. */
- if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+ if (TYPE_IS_PADDING_P (type))
{
if ((!size
|| operand_equal_p (round_up (size,
generate incorrect debugging information. So make a new record
type and name. */
record = make_node (RECORD_TYPE);
- TYPE_IS_PADDING_P (record) = 1;
+ TYPE_PADDING_P (record) = 1;
if (Present (gnat_entity))
- TYPE_NAME (record) = create_concat_name (gnat_entity, name_trailer);
+ TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
TYPE_VOLATILE (record)
= Present (gnat_entity) && Treat_As_Volatile (gnat_entity);
TYPE_ALIGN (record) = align;
- if (orig_align)
- TYPE_USER_ALIGN (record) = align;
-
TYPE_SIZE (record) = size ? size : orig_size;
TYPE_SIZE_UNIT (record)
= convert (sizetype,
}
/* Now create the field with the original size. */
- field = create_field_decl (get_identifier ("F"), type, record, 0,
- orig_size, bitsize_zero_node, 1);
+ field = create_field_decl (get_identifier ("F"), type, record, orig_size,
+ bitsize_zero_node, 0, 1);
DECL_INTERNAL_P (field) = 1;
- /* Do not finalize it until after the auxiliary record is built. */
- finish_record_type (record, field, 1, true);
+ /* Do not emit debug info until after the auxiliary record is built. */
+ finish_record_type (record, field, 1, false);
/* Set the same size for its RM size if requested; otherwise reuse
the RM size of the original type. */
/* Unless debugging information isn't being written for the input type,
write a record that shows what we are a subtype of and also make a
variable that indicates our size, if still variable. */
- if (TYPE_NAME (record)
- && AGGREGATE_TYPE_P (type)
- && TREE_CODE (orig_size) != INTEGER_CST
+ if (TREE_CODE (orig_size) != INTEGER_CST
+ && TYPE_NAME (record)
+ && TYPE_NAME (type)
&& !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
&& DECL_IGNORED_P (TYPE_NAME (type))))
{
finish_record_type (marker,
create_field_decl (orig_name,
build_reference_type (type),
- marker, 0, NULL_TREE, NULL_TREE,
- 0),
- 0, false);
+ marker, NULL_TREE, NULL_TREE,
+ 0, 0),
+ 0, true);
add_parallel_type (TYPE_STUB_DECL (record), marker);
- if (size && TREE_CODE (size) != INTEGER_CST && definition)
- create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
- TYPE_SIZE_UNIT (record), false, false, false,
- false, NULL, gnat_entity);
+ if (definition && size && TREE_CODE (size) != INTEGER_CST)
+ TYPE_SIZE_UNIT (marker)
+ = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
+ TYPE_SIZE_UNIT (record), false, false, false,
+ false, NULL, gnat_entity);
}
rest_of_record_type_compilation (record);
if (Present (gnat_entity)
&& size
+ && TREE_CODE (size) != MAX_EXPR
+ && TREE_CODE (size) != COND_EXPR
&& !operand_equal_p (size, orig_size, 0)
&& !(TREE_CODE (size) == INTEGER_CST
&& TREE_CODE (orig_size) == INTEGER_CST
- && tree_int_cst_lt (size, orig_size)))
+ && (TREE_OVERFLOW (size)
+ || TREE_OVERFLOW (orig_size)
+ || tree_int_cst_lt (size, orig_size))))
{
Node_Id gnat_error_node = Empty;
post_error_ne_tree ("{^ }bits of & unused?",
gnat_error_node, gnat_entity,
size_diffop (size, orig_size));
- else if (name_trailer[0] == 'C')
+ else if (is_component_type)
post_error_ne_tree ("component of& padded{ by ^ bits}?",
gnat_entity, gnat_entity,
size_diffop (size, orig_size));
low = gnat_to_gnu (Low_Bound (choice));
high = gnat_to_gnu (High_Bound (choice));
- /* There's no good type to use here, so we might as well use
- integer_type_node. */
this_test
- = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
- build_binary_op (GE_EXPR, integer_type_node,
+ = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+ build_binary_op (GE_EXPR, boolean_type_node,
operand, low),
- build_binary_op (LE_EXPR, integer_type_node,
+ build_binary_op (LE_EXPR, boolean_type_node,
operand, high));
break;
high = gnat_to_gnu (High_Bound (gnat_temp));
this_test
- = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
- build_binary_op (GE_EXPR, integer_type_node,
+ = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+ build_binary_op (GE_EXPR, boolean_type_node,
operand, low),
- build_binary_op (LE_EXPR, integer_type_node,
+ build_binary_op (LE_EXPR, boolean_type_node,
operand, high));
break;
high = TYPE_MAX_VALUE (type);
this_test
- = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
- build_binary_op (GE_EXPR, integer_type_node,
+ = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+ build_binary_op (GE_EXPR, boolean_type_node,
operand, low),
- build_binary_op (LE_EXPR, integer_type_node,
+ build_binary_op (LE_EXPR, boolean_type_node,
operand, high));
break;
}
case N_Character_Literal:
case N_Integer_Literal:
single = gnat_to_gnu (choice);
- this_test = build_binary_op (EQ_EXPR, integer_type_node, operand,
+ this_test = build_binary_op (EQ_EXPR, boolean_type_node, operand,
single);
break;
gcc_unreachable ();
}
- result = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
- result, this_test);
+ result = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, result,
+ this_test);
}
return result;
else
gnu_size = NULL_TREE;
- /* If we have a specified size that's smaller than that of the field type,
- or a position is specified, and the field type is a record, see if we can
- get either an integral mode form of the type or a smaller form. If we
- can, show a size was specified for the field if there wasn't one already,
- so we know to make this a bitfield and avoid making things wider.
+ /* If we have a specified size that is smaller than that of the field's type,
+ or a position is specified, and the field's type is a record that doesn't
+ require strict alignment, see if we can get either an integral mode form
+ of the type or a smaller form. If we can, show a size was specified for
+ the field if there wasn't one already, so we know to make this a bitfield
+ and avoid making things wider.
- Doing this is first useful if the record is packed because we may then
- place the field at a non-byte-aligned position and so achieve tighter
- packing.
+ Changing to an integral mode form is useful when the record is packed as
+ we can then place the field at a non-byte-aligned position and so achieve
+ tighter packing. This is in addition required if the field shares a byte
+ with another field and the front-end lets the back-end handle the access
+ to the field, because GCC cannot handle non-byte-aligned BLKmode fields.
- This is in addition *required* if the field shares a byte with another
- field and the front-end lets the back-end handle the references, because
- GCC does not handle BLKmode bitfields properly.
+ Changing to a smaller form is required if the specified size is smaller
+ than that of the field's type and the type contains sub-fields that are
+ padded, in order to avoid generating accesses to these sub-fields that
+ are wider than the field.
We avoid the transformation if it is not required or potentially useful,
as it might entail an increase of the field's alignment and have ripple
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.
-
- Besides, we don't even look the possibility of a transformation in cases
- known to be in error already, for instance when an invalid size results
- from a component clause. */
-
- if (TREE_CODE (gnu_field_type) == RECORD_TYPE
- && !TYPE_IS_FAT_POINTER_P (gnu_field_type)
+ byte-aligned and not to share a byte with another field. */
+ if (!needs_strict_alignment
+ && TREE_CODE (gnu_field_type) == RECORD_TYPE
+ && !TYPE_FAT_POINTER_P (gnu_field_type)
&& host_integerp (TYPE_SIZE (gnu_field_type), 1)
&& (packed == 1
|| (gnu_size
&& (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
- || Present (Component_Clause (gnat_field))))))
+ || (Present (Component_Clause (gnat_field))
+ && !(UI_To_Int (Component_Bit_Offset (gnat_field))
+ % BITS_PER_UNIT == 0
+ && value_factor_p (gnu_size, BITS_PER_UNIT)))))))
{
- /* See what the alternate type and size would be. */
tree gnu_packable_type = make_packable_type (gnu_field_type, true);
-
- bool has_byte_aligned_clause
- = Present (Component_Clause (gnat_field))
- && (UI_To_Int (Component_Bit_Offset (gnat_field))
- % BITS_PER_UNIT == 0);
-
- /* Compute whether we should avoid the substitution. */
- bool reject
- /* There is no point substituting if there is no change... */
- = (gnu_packable_type == gnu_field_type)
- /* ... nor when the field is known to be byte aligned and not to
- share a byte with another field. */
- || (has_byte_aligned_clause
- && value_factor_p (gnu_size, BITS_PER_UNIT))
- /* The size of an aliased field must be an exact multiple of the
- type's alignment, which the substitution might increase. Reject
- substitutions that would so invalidate a component clause when the
- specified position is byte aligned, as the change would have no
- real benefit from the packing standpoint anyway. */
- || (Is_Aliased (gnat_field)
- && has_byte_aligned_clause
- && !value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type)));
-
- /* Substitute unless told otherwise. */
- if (!reject)
+ if (gnu_packable_type != gnu_field_type)
{
gnu_field_type = gnu_packable_type;
-
if (!gnu_size)
gnu_size = rm_size (gnu_field_type);
}
orig_field_type = gnu_field_type;
gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
- "PAD", false, definition, true);
+ false, false, definition, true);
/* If a padding record was made, declare it now since it will never be
declared otherwise. This is necessary to ensure that its subtrees
|| !TYPE_CONTAINS_TEMPLATE_P (gnu_field_type));
/* Now create the decl for the field. */
- gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
- packed, gnu_size, gnu_pos,
- Is_Aliased (gnat_field));
+ gnu_field
+ = 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));
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
if (!TREE_CONSTANT (TYPE_SIZE (type)))
return true;
- if (TREE_CODE (type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (type)
+ if (TYPE_IS_PADDING_P (type)
&& !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
return true;
with Component_Alignment of Storage_Unit, -2 if this is for a record
with a specified alignment.
- DEFINITION is true if we are defining this record.
+ DEFINITION is true if we are defining this record type.
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.
- CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before
- laying out the record. This means the alignment only serves to force
- fields to be bitfields, but not require the record to be that aligned.
- This is used for variants.
+ CANCEL_ALIGNMENT is true if the alignment should be zeroed before laying
+ out the record. This means the alignment only serves to force fields to
+ be bitfields, but not to require the record to be that aligned. This is
+ used for variants.
- ALL_REP, if true, means a rep clause was found for all the fields. This
- simplifies the logic since we know we're not in the mixed case.
+ ALL_REP is true if a rep clause is present for all the fields.
- DO_NOT_FINALIZE, if true, means that the record type is expected to be
- modified afterwards so it will not be finalized here.
+ UNCHECKED_UNION is true if we are building this type for a record with a
+ Pragma Unchecked_Union.
- UNCHECKED_UNION, if true, means that we are building a type for a record
- with a Pragma Unchecked_Union.
+ DEBUG_INFO_P 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
+ mean that its contents may be unused as well, but only the container. */
- DEBUG_INFO_P, if true, means that we need to write debug information for
- types that we may create in the process. */
static void
components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition,
tree *p_gnu_rep_list, bool cancel_alignment,
- bool all_rep, bool do_not_finalize,
- bool unchecked_union, bool debug_info_p)
+ bool all_rep, bool unchecked_union, bool debug_info_p,
+ bool maybe_unused)
{
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
bool layout_with_rep = false;
= TYPE_SIZE_UNIT (gnu_record_type);
}
- /* Add the fields into the record type for the variant. Note that we
- defer finalizing it until after we are sure to really use it. */
+ /* Add the fields into the record type for the variant. Note that
+ 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,
&gnu_our_rep_list, !all_rep_and_size, all_rep,
- true, unchecked_union, debug_info_p);
+ unchecked_union, debug_info_p, true);
gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type,
NULL, true, debug_info_p, gnat_component_list);
- gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type,
- gnu_union_type, field_packed,
- (all_rep_and_size
- ? TYPE_SIZE (gnu_variant_type)
- : 0),
- (all_rep_and_size
- ? bitsize_zero_node : 0),
- 0);
+ gnu_field
+ = create_field_decl (gnu_inner_name, gnu_variant_type,
+ gnu_union_type,
+ all_rep_and_size
+ ? TYPE_SIZE (gnu_variant_type) : 0,
+ all_rep_and_size
+ ? bitsize_zero_node : 0,
+ field_packed, 0);
DECL_INTERNAL_P (gnu_field) = 1;
}
finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
- all_rep_and_size ? 1 : 0, false);
+ all_rep_and_size ? 1 : 0, debug_info_p);
/* If GNU_UNION_TYPE is our record type, it means we must have an
Unchecked_Union with no fields. Verify that and, if so, just
gnu_union_field
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
- union_field_packed,
all_rep ? TYPE_SIZE (gnu_union_type) : 0,
- all_rep ? bitsize_zero_node : 0, 0);
+ all_rep ? bitsize_zero_node : 0,
+ union_field_packed, 0);
DECL_INTERNAL_P (gnu_union_field) = 1;
TREE_CHAIN (gnu_union_field) = gnu_field_list;
if (gnu_field_list)
{
- finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, false);
+ finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, debug_info_p);
gnu_field
= create_field_decl (get_identifier ("REP"), gnu_rep_type,
- gnu_record_type, 0, NULL_TREE, NULL_TREE, 1);
+ gnu_record_type, NULL_TREE, NULL_TREE, 0, 1);
DECL_INTERNAL_P (gnu_field) = 1;
gnu_field_list = chainon (gnu_field_list, gnu_field);
}
TYPE_ALIGN (gnu_record_type) = 0;
finish_record_type (gnu_record_type, nreverse (gnu_field_list),
- layout_with_rep ? 1 : 0, do_not_finalize);
+ layout_with_rep ? 1 : 0, debug_info_p && !maybe_unused);
}
\f
/* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
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 i;
/* See if we've already saved the value for this node. */
if (EXPR_P (gnu_size))
if (TREE_OVERFLOW (gnu_size))
return No_Uint;
- /* This may have come from a conversion from some smaller type,
- so ensure this is in bitsizetype. */
+ /* This may come from a conversion from some smaller type, so ensure
+ this is in bitsizetype. */
gnu_size = convert (bitsizetype, gnu_size);
- /* For negative values, use NEGATE_EXPR of the supplied value. */
- if (tree_int_cst_sgn (gnu_size) < 0)
+ /* For a negative value, build NEGATE_EXPR of the opposite. Such values
+ appear in expressions containing aligning patterns. Note that, since
+ sizetype is sign-extended but nonetheless unsigned, we don't directly
+ use tree_int_cst_sgn. */
+ if (TREE_INT_CST_HIGH (gnu_size) < 0)
{
- /* The ridiculous code below is to handle the case of the largest
- negative integer. */
- tree negative_size = size_diffop (bitsize_zero_node, gnu_size);
- bool adjust = false;
- tree temp;
-
- if (TREE_OVERFLOW (negative_size))
- {
- negative_size
- = size_binop (MINUS_EXPR, bitsize_zero_node,
- size_binop (PLUS_EXPR, gnu_size,
- bitsize_one_node));
- adjust = true;
- }
-
- temp = build1 (NEGATE_EXPR, bitsizetype, negative_size);
- if (adjust)
- temp = build2 (MINUS_EXPR, bitsizetype, temp, bitsize_one_node);
-
- return annotate_value (temp);
+ tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
+ return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
}
- if (!host_integerp (gnu_size, 1))
- return No_Uint;
-
- size = tree_low_cst (gnu_size, 1);
-
- /* This peculiar test is to make sure that the size fits in an int
- on machines where HOST_WIDE_INT is not "int". */
- if (tree_low_cst (gnu_size, 1) == size)
- return UI_From_Int (size);
- else
- return No_Uint;
+ return UI_From_gnu (gnu_size);
case COMPONENT_REF:
/* The only case we handle here is a simple discriminant reference. */
for (i = 0; i < 3; i++)
ops[i] = No_Uint;
- for (i = 0; i < len; i++)
+ for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
{
ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
if (ops[i] == No_Uint)
{
if (by_ref)
{
- if (TYPE_FAT_POINTER_P (gnu_type))
+ if (TYPE_IS_FAT_POINTER_P (gnu_type))
gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
else
gnu_type = TREE_TYPE (gnu_type);
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. */
+
+static tree
+purpose_member_field (const_tree elem, tree list)
+{
+ while (list)
+ {
+ tree field = TREE_PURPOSE (list);
+ if (SAME_FIELD_P (field, elem))
+ return list;
+ list = TREE_CHAIN (list);
+ }
+ return NULL_TREE;
+}
+
/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type,
set Component_Bit_Offset and Esize of the components to the position and
size used by Gigi. */
|| (Ekind (gnat_field) == E_Discriminant
&& !Is_Unchecked_Union (Scope (gnat_field))))
{
- tree parent_offset, t;
-
- t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list);
+ tree t = purpose_member_field (gnat_to_gnu_field_decl (gnat_field),
+ gnu_list);
if (t)
{
+ tree parent_offset;
+
if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
/* In this mode the tag and parent components are not
gnat_value = Next_Elmt (gnat_value))
/* Ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_value))))
- gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim),
- elaborate_expression
- (Node (gnat_value), gnat_subtype,
- get_entity_name (gnat_discrim), definition,
- true, false),
- gnu_list);
+ {
+ tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
+ gnu_list = tree_cons (gnu_field,
+ convert (TREE_TYPE (gnu_field),
+ elaborate_expression
+ (Node (gnat_value), gnat_subtype,
+ get_entity_name (gnat_discrim),
+ definition, true, false)),
+ gnu_list);
+ }
return gnu_list;
}
Node_Id gnat_error_node;
tree type_size, 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);
+ /* Return 0 if no size was specified. */
+ if (uint_size == No_Uint)
+ return NULL_TREE;
+
+ /* Ignore a negative size since that corresponds to our back-annotation. */
+ if (UI_Lt (uint_size, Uint_0))
+ return NULL_TREE;
/* 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))
{
- post_error_ne (component_p ? "component size of & is too large"
- : "size of & is too large",
- gnat_error_node, gnat_object);
+ 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);
return NULL_TREE;
}
- /* Ignore a negative size since that corresponds to our back-annotation.
- Also ignore a zero size if it is not permitted. */
- if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
+ /* Ignore a zero size if it is not permitted. */
+ if (!zero_ok && integer_zerop (size))
return NULL_TREE;
/* The size of objects is always a multiple of a byte. */
&& 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))
/* If this is an access type or a fat pointer, the minimum size is that given
by the smallest integral mode that's valid for pointers. */
- if ((TREE_CODE (gnu_type) == POINTER_TYPE) || TYPE_FAT_POINTER_P (gnu_type))
+ if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type))
{
- 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))
- ;
-
+ 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);
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);
-
- 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);
+ post_error_ne_tree
+ ("size for& too small{, minimum allowed is ^}",
+ gnat_error_node, gnat_object, type_size);
- return NULL_TREE;
+ size = 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;
+
+ /* Ignore a negative size since that corresponds to our back-annotation. */
+ if (UI_Lt (uint_size, Uint_0))
+ return;
+
/* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */
- Node_Id gnat_attr_node
+ 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. */
return;
}
- /* Ignore a negative size since that corresponds to our back-annotation.
- Also ignore a zero size unless a Value_Size clause exists, or a size
- clause exists, or this is an integer type, in which case the front-end
- will have always set it. */
- if (tree_int_cst_sgn (size) < 0
- || (integer_zerop (size)
- && No (gnat_attr_node)
- && !Has_Size_Clause (gnat_entity)
- && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
+ /* Ignore a zero size unless a Value_Size clause exists, or a size clause
+ exists, or this is an integer type, in which case the front-end will
+ have always set it. */
+ if (No (gnat_attr_node)
+ && integer_zerop (size)
+ && !Has_Size_Clause (gnat_entity)
+ && !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);
|| (AGGREGATE_TYPE_P (gnu_type)
&& !(TREE_CODE (gnu_type) == ARRAY_TYPE
&& TYPE_PACKED_ARRAY_TYPE_P (gnu_type))
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_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))
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (gnu_type))
+ && !TYPE_FAT_POINTER_P (gnu_type))
SET_TYPE_ADA_SIZE (gnu_type, size);
}
\f
biased_p = (TREE_CODE (type) == INTEGER_TYPE
&& TYPE_BIASED_REPRESENTATION_P (type));
+ /* Integer types with precision 0 are forbidden. */
+ if (size == 0)
+ size = 1;
+
/* 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)
SET_TYPE_RM_MAX_VALUE (new_type,
convert (TREE_TYPE (new_type),
TYPE_MAX_VALUE (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);
- }
+ /* Copy the name to show that it's essentially the same type and
+ not a subrange type. */
+ 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;
case RECORD_TYPE:
/* Do something if this is a fat pointer, in which case we
may need to return the thin pointer. */
- if (TYPE_IS_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
+ if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
{
enum machine_mode p_mode = mode_for_size (size, MODE_INT, 0);
if (!targetm.valid_pointer_mode (p_mode))
case POINTER_TYPE:
/* Only do something if this is a thin pointer, in which case we
may need to return the fat pointer. */
- if (TYPE_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2)
+ if (TYPE_IS_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2)
return
build_pointer_type (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)));
break;
OBJECT is either a type or a decl. */
if (TYPE_P (object))
{
+ /* If this is an anonymous base type, nothing to check. Error will be
+ reported on the source type. */
+ if (!Comes_From_Source (gnat_entity))
+ return;
+
mode = TYPE_MODE (object);
align = TYPE_ALIGN (object);
size = TYPE_SIZE (object);
new_field
= create_field_decl (DECL_NAME (old_field), field_type, record_type,
- DECL_PACKED (old_field), size, new_pos,
+ size, new_pos, DECL_PACKED (old_field),
!DECL_NONADDRESSABLE_P (old_field));
if (!new_pos)
}
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- t = DECL_ORIGINAL_FIELD (old_field);
- SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field);
+ SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field);
TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field);
tree record_type, tree pos_list, tree subst_list)
{
tree offset = DECL_FIELD_OFFSET (old_variant_part);
- tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part);
tree old_union_type = TREE_TYPE (old_variant_part);
tree new_union_type, new_variant_part, t;
tree union_field_list = NULL_TREE;
/* 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
reduces the code size when not optimizing. */
- if (TREE_CODE (offset) == INTEGER_CST && TREE_CODE (bitpos) == INTEGER_CST)
+ if (TREE_CODE (offset) == INTEGER_CST)
{
+ tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part);
tree first_bit = bit_from_pos (offset, bitpos);
TYPE_SIZE (new_union_type)
= size_binop (MINUS_EXPR, TYPE_SIZE (record_type), first_bit);
field_list = new_variant_subpart;
}
- /* Finish up the new variant and create the field. */
- finish_record_type (new_variant, nreverse (field_list), 2, true);
+ /* Finish up the new variant and create the field. No need for debug
+ info thanks to the XVS type. */
+ finish_record_type (new_variant, nreverse (field_list), 2, false);
compute_record_mode (new_variant);
- rest_of_record_type_compilation (new_variant);
-
- /* No need for debug info thanks to the XVS type. */
create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
true, false, Empty);
union_field_list = new_field;
}
- /* Finish up the union type and create the variant part. */
- finish_record_type (new_union_type, union_field_list, 2, true);
+ /* Finish up the union type and create the variant part. No need for debug
+ info thanks to the XVS type. */
+ finish_record_type (new_union_type, union_field_list, 2, false);
compute_record_mode (new_union_type);
- rest_of_record_type_compilation (new_union_type);
-
- /* No need for debug info thanks to the XVS type. */
create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
true, false, Empty);
}
DECL_CONTEXT (new_field) = nt;
- SET_DECL_ORIGINAL_FIELD (new_field,
- (DECL_ORIGINAL_FIELD (field)
- ? DECL_ORIGINAL_FIELD (field) : field));
+ SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field);
TREE_CHAIN (new_field) = TYPE_FIELDS (nt);
TYPE_FIELDS (nt) = new_field;
if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (gnu_type)
+ && !TYPE_FAT_POINTER_P (gnu_type)
&& TYPE_ADA_SIZE (gnu_type))
return TYPE_ADA_SIZE (gnu_type);