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 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);
+ /* 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. */
&& (((Nkind (Declaration_Node (gnat_entity))
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
- || Present (Renamed_Object (gnat_entity))));
+ || Present (Renamed_Object (gnat_entity))
+ || imported_p));
bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity);
bool mutable_p = false;
/* Get the type after elaborating the renamed object. */
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
+ /* If this is a standard exception definition, then use the standard
+ exception type. This is necessary to make sure that imported and
+ exported views of exceptions are properly merged in LTO mode. */
+ if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL
+ && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)
+ gnu_type = except_type_node;
+
/* For a debug renaming declaration, build a pure debug entity. */
if (Present (Debug_Renaming_Link (gnat_entity)))
{
&& kind != E_Out_Parameter
&& Is_Composite_Type (Etype (gnat_entity))
&& !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+ && !Is_Exported (gnat_entity)
&& !imported_p
&& No (Renamed_Object (gnat_entity))
&& No (Address_Clause (gnat_entity))))
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
and disallow any optimizations for such a non-constant object. */
if ((Treat_As_Volatile (gnat_entity)
|| (!const_flag
+ && gnu_type != except_type_node
&& (Is_Exported (gnat_entity)
- || Is_Imported (gnat_entity)
+ || imported_p
|| Present (Address_Clause (gnat_entity)))))
&& !TYPE_VOLATILE (gnu_type))
gnu_type = build_qualified_type (gnu_type,
(TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
static_p = true;
- /* 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),
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)))
+ /* 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)
TREE_ADDRESSABLE (gnu_decl) = 1;
/* If we are defining an object with variable size or an object with
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);
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, boolean_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. */
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
- && (TYPE_UNSIGNED (gnu_index_type)
- || !TYPE_UNSIGNED (sizetype)))
- || (prec_comp == 0
- && TYPE_UNSIGNED (gnu_index_type)
- == TYPE_UNSIGNED (sizetype));
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,
- boolean_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)
- || prec_comp > 0)
+ || compare_tree_int (rm_size (gnu_index_type),
+ TYPE_PRECISION (sizetype)) > 0)
need_index_type_struct = true;
}
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;
}
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;
debug_info_p, false);
/* If it is passed by reference, force BLKmode to ensure that objects
- of this type will always be put in memory. */
++ of this type will always be put in memory. */
if (Is_By_Reference_Type (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
&& Is_Itype (Etype (gnat_temp))
&& !present_gnu_tree (gnat_temp))
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
+
+ /* If this is a record type associated with an exception definition,
+ equate its fields to those of the standard exception type. This
+ will make it possible to convert between them. */
+ if (gnu_entity_name == exception_data_name_id)
+ {
+ tree gnu_std_field;
+ for (gnu_field = TYPE_FIELDS (gnu_type),
+ gnu_std_field = TYPE_FIELDS (except_type_node);
+ gnu_field;
+ gnu_field = TREE_CHAIN (gnu_field),
+ gnu_std_field = TREE_CHAIN (gnu_std_field))
+ SET_DECL_ORIGINAL_FIELD_TO_FIELD (gnu_field, gnu_std_field);
+ gcc_assert (!gnu_std_field);
+ }
}
break;
break;
}
+ /* If this is a record subtype associated with a dispatch table,
+ strip the suffix. This is necessary to make sure 2 different
+ subtypes associated with the imported and exported views of a
+ dispatch table are properly merged in LTO mode. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
+ {
+ char *p;
+ Get_Encoded_Name (gnat_entity);
+ p = strchr (Name_Buffer, '_');
+ gcc_assert (p);
+ strcpy (p+2, "dtS");
+ gnu_entity_name = get_identifier (Name_Buffer);
+ }
+
/* When the subtype has discriminants and these discriminants affect
the initial shape it has inherited, factor them in. But for an
Unchecked_Union (it must be an Itype), just return the type.
build_reference_type
(gnu_unpad_base_type),
gnu_subtype_marker,
- 0, NULL_TREE,
- NULL_TREE, 0),
+ NULL_TREE, NULL_TREE,
+ 0, 0),
0, true);
add_parallel_type (TYPE_STUB_DECL (gnu_type),
if (definition
&& TREE_CODE (gnu_size_unit) != INTEGER_CST
&& !CONTAINS_PLACEHOLDER_P (gnu_size_unit))
- create_var_decl (create_concat_name (gnat_entity, "XVZ"),
- NULL_TREE, sizetype, gnu_size_unit, false,
- false, false, false, NULL, gnat_entity);
+ 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. */
case E_Anonymous_Access_Type:
case E_General_Access_Type:
{
+ /* The designated type and its equivalent type for gigi. */
Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity);
Entity_Id gnat_desig_equiv = Gigi_Equivalent_Type (gnat_desig_type);
+ /* Whether it comes from a limited with. */
bool is_from_limited_with
= (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
&& From_With_Type (gnat_desig_equiv));
-
- /* Get the "full view" of this entity. If this is an incomplete
+ /* The "full view" of the designated type. If this is an incomplete
entity from a limited with, treat its non-limited view as the full
view. Otherwise, if this is an incomplete or private type, use the
full view. In the former case, we might point to a private type,
actual type used for the representation, so this takes a total of
three steps. */
Entity_Id gnat_desig_full_direct_first
- = (is_from_limited_with ? Non_Limited_View (gnat_desig_equiv)
+ = (is_from_limited_with
+ ? Non_Limited_View (gnat_desig_equiv)
: (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind)
? Full_View (gnat_desig_equiv) : Empty));
Entity_Id gnat_desig_full_direct
: gnat_desig_full_direct_first);
Entity_Id gnat_desig_full
= Gigi_Equivalent_Type (gnat_desig_full_direct);
-
- /* This the type actually used to represent the designated type,
- either gnat_desig_full or gnat_desig_equiv. */
+ /* The type actually used to represent the designated type, either
+ gnat_desig_full or gnat_desig_equiv. */
Entity_Id gnat_desig_rep;
-
/* True if this is a pointer to an unconstrained array. */
bool is_unconstrained_array;
-
/* We want to know if we'll be seeing the freeze node for any
incomplete type we may be pointing to. */
bool in_main_unit
= (Present (gnat_desig_full)
? In_Extended_Main_Code_Unit (gnat_desig_full)
: In_Extended_Main_Code_Unit (gnat_desig_type));
-
/* True if we make a dummy type here. */
- bool got_fat_p = false;
- /* True if the dummy is a fat pointer. */
bool made_dummy = false;
- tree gnu_desig_type = NULL_TREE;
+ /* True if the dummy type is a fat pointer. */
+ bool got_fat_p = false;
+ /* The mode to be used for the pointer type. */
enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
+ /* The GCC type used for the designated type. */
+ tree gnu_desig_type = NULL_TREE;
if (!targetm.valid_pointer_mode (p_mode))
p_mode = ptr_mode;
issues. This can lose some code efficiency, but there is no
alternative. */
if (Ekind (gnat_desig_equiv) == E_Array_Subtype
- && ! Is_Constrained (gnat_desig_equiv))
+ && !Is_Constrained (gnat_desig_equiv))
gnat_desig_equiv = Etype (gnat_desig_equiv);
if (Present (gnat_desig_full)
&& ((Ekind (gnat_desig_full) == E_Array_Subtype
- && ! Is_Constrained (gnat_desig_full))
+ && !Is_Constrained (gnat_desig_full))
|| (Ekind (gnat_desig_full) == E_Record_Subtype
&& Ekind (Etype (gnat_desig_full)) == E_Record_Type)))
gnat_desig_full = Etype (gnat_desig_full);
- /* Now set the type that actually marks the representation of
- the designated type and also flag whether we have a unconstrained
- array. */
- gnat_desig_rep = gnat_desig_full ? gnat_desig_full : gnat_desig_equiv;
+ /* Set the type that's actually the representation of the designated
+ type and also flag whether we have a unconstrained array. */
+ gnat_desig_rep
+ = Present (gnat_desig_full) ? gnat_desig_full : gnat_desig_equiv;
is_unconstrained_array
- = (Is_Array_Type (gnat_desig_rep)
- && ! Is_Constrained (gnat_desig_rep));
+ = Is_Array_Type (gnat_desig_rep) && !Is_Constrained (gnat_desig_rep);
/* If we are pointing to an incomplete type whose completion is an
unconstrained array, make a fat pointer type. The two types in our
if (is_unconstrained_array
&& (Present (gnat_desig_full)
|| (present_gnu_tree (gnat_desig_equiv)
- && TYPE_IS_DUMMY_P (TREE_TYPE
- (get_gnu_tree (gnat_desig_equiv))))
- || (No (gnat_desig_full) && ! in_main_unit
- && defer_incomplete_level != 0
- && ! present_gnu_tree (gnat_desig_equiv))
- || (in_main_unit && is_from_limited_with
- && Present (Freeze_Node (gnat_desig_rep)))))
+ && TYPE_IS_DUMMY_P
+ (TREE_TYPE (get_gnu_tree (gnat_desig_equiv))))
+ || (!in_main_unit
+ && defer_incomplete_level
+ && !present_gnu_tree (gnat_desig_equiv))
+ || (in_main_unit
+ && is_from_limited_with
+ && Present (Freeze_Node (gnat_desig_equiv)))))
{
- tree gnu_old;
-
if (present_gnu_tree (gnat_desig_rep))
- gnu_old = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
+ gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
else
{
- gnu_old = make_dummy_type (gnat_desig_rep);
-
+ gnu_desig_type = make_dummy_type (gnat_desig_rep);
/* Show the dummy we get will be a fat pointer. */
got_fat_p = made_dummy = true;
}
- /* If the call above got something that has a pointer, that
- pointer is our type. This could have happened either
- because the type was elaborated or because somebody
- else executed the code below. */
- gnu_type = TYPE_POINTER_TO (gnu_old);
+ /* If the call above got something that has a pointer, the pointer
+ is our type. This could have happened either because the type
+ was elaborated or because somebody else executed the code. */
+ gnu_type = TYPE_POINTER_TO (gnu_desig_type);
if (!gnu_type)
{
tree gnu_template_type = make_node (ENUMERAL_TYPE);
TYPE_DUMMY_P (gnu_array_type) = 1;
gnu_type = make_node (RECORD_TYPE);
- SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
- TYPE_POINTER_TO (gnu_old) = gnu_type;
+ SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_desig_type);
+ TYPE_POINTER_TO (gnu_desig_type) = gnu_type;
fields
- = chainon (chainon (NULL_TREE,
- create_field_decl
- (get_identifier ("P_ARRAY"),
- gnu_ptr_array,
- gnu_type, 0, 0, 0, 0)),
- create_field_decl (get_identifier ("P_BOUNDS"),
- gnu_ptr_template,
- gnu_type, 0, 0, 0, 0));
+ = create_field_decl (get_identifier ("P_ARRAY"),
+ gnu_ptr_array, gnu_type,
+ NULL_TREE, NULL_TREE, 0, 0);
+ TREE_CHAIN (fields)
+ = create_field_decl (get_identifier ("P_BOUNDS"),
+ gnu_ptr_template, gnu_type,
+ NULL_TREE, NULL_TREE, 0, 0);
/* Make sure we can place this into a register. */
TYPE_ALIGN (gnu_type)
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))
+ TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)
+ = make_node (RECORD_TYPE);
+ TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type))
= create_concat_name (gnat_desig_equiv, "XUT");
- TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = 1;
+ TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)) = 1;
}
}
&& present_gnu_tree (gnat_desig_full))
gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full));
- /* Get the type of the thing we are to point to and build a pointer
- to it. If it is a reference to an incomplete or private type with a
+ /* Get the type of the thing we are to point to and build a pointer to
+ it. If it is a reference to an incomplete or private type with a
full view that is a record, make a dummy type node and get the
actual type later when we have verified it is safe. */
- else if ((! in_main_unit
- && ! present_gnu_tree (gnat_desig_equiv)
+ else if ((!in_main_unit
+ && !present_gnu_tree (gnat_desig_equiv)
&& Present (gnat_desig_full)
- && ! present_gnu_tree (gnat_desig_full)
+ && !present_gnu_tree (gnat_desig_full)
&& Is_Record_Type (gnat_desig_full))
- /* Likewise if we are pointing to a record or array and we
- are to defer elaborating incomplete types. We do this
- since this access type may be the full view of some
- private type. Note that the unconstrained array case is
- handled above. */
- || ((! in_main_unit || imported_p)
- && defer_incomplete_level != 0
- && ! present_gnu_tree (gnat_desig_equiv)
- && ((Is_Record_Type (gnat_desig_rep)
- || Is_Array_Type (gnat_desig_rep))))
+ /* Likewise if we are pointing to a record or array and we are
+ to defer elaborating incomplete types. We do this as this
+ access type may be the full view of a private type. Note
+ that the unconstrained array case is handled above. */
+ || ((!in_main_unit || imported_p)
+ && defer_incomplete_level
+ && !present_gnu_tree (gnat_desig_equiv)
+ && (Is_Record_Type (gnat_desig_rep)
+ || Is_Array_Type (gnat_desig_rep)))
/* If this is a reference from a limited_with type back to our
- main unit and there's a Freeze_Node for it, either we have
+ main unit and there's a freeze node for it, either we have
already processed the declaration and made the dummy type,
in which case we just reuse the latter, or we have not yet,
in which case we make the dummy type and it will be reused
- when the declaration is processed. In both cases, the
- pointer eventually created below will be automatically
- adjusted when the Freeze_Node is processed. Note that the
+ when the declaration is finally processed. In both cases,
+ the pointer eventually created below will be automatically
+ adjusted when the freeze node is processed. Note that the
unconstrained array case is handled above. */
- || (in_main_unit && is_from_limited_with
+ || (in_main_unit
+ && is_from_limited_with
&& Present (Freeze_Node (gnat_desig_rep))))
{
gnu_desig_type = make_dummy_type (gnat_desig_equiv);
TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
}
- /* If expansion is disabled, the equivalent type of a concurrent
- type is absent, so build a dummy pointer type. */
+ /* If expansion is disabled, the equivalent type of a concurrent type
+ is absent, so build a dummy pointer type. */
else if (type_annotate_only && No (gnat_desig_equiv))
gnu_type = ptr_void_type_node;
- /* Finally, handle the straightforward case where we can just
- elaborate our designated type and point to it. */
+ /* Finally, handle the default case where we can just elaborate our
+ designated type. */
else
gnu_desig_type = gnat_to_gnu_type (gnat_desig_equiv);
break;
}
- /* If we have a GCC type for the designated type, possibly modify it
- if we are pointing only to constant objects and then make a pointer
- to it. Don't do this for unconstrained arrays. */
- if (!gnu_type && gnu_desig_type)
+ /* If we have not done it yet, build the pointer type the usual way. */
+ if (!gnu_type)
{
+ /* Modify the designated type if we are pointing only to constant
+ objects, but don't do it for unconstrained arrays. */
if (Is_Access_Constant (gnat_entity)
&& TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE)
{
No_Strict_Aliasing (gnat_entity));
}
- /* If we are not defining this object and we made a dummy pointer,
+ /* If we are not defining this object and we have made a dummy pointer,
save our current definition, evaluate the actual type, and replace
the tentative type we made with the actual one. If we are to defer
- actually looking up the actual type, make an entry in the
- deferred list. If this is from a limited with, we have to defer
- to the end of the current spec in two cases: first if the
- designated type is in the current unit and second if the access
- type is. */
- if ((! in_main_unit || is_from_limited_with) && made_dummy)
+ actually looking up the actual type, make an entry in the deferred
+ list. If this is from a limited with, we have to defer to the end
+ of the current spec in two cases: first if the designated type is
+ in the current unit and second if the access type itself is. */
+ if ((!in_main_unit || is_from_limited_with) && made_dummy)
{
- tree gnu_old_type
+ bool is_from_limited_with_in_main_unit
+ = (is_from_limited_with
+ && (in_main_unit
+ || In_Extended_Main_Code_Unit (gnat_entity)));
+ tree gnu_old_desig_type
= TYPE_IS_FAT_POINTER_P (gnu_type)
? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
save_gnu_tree (gnat_entity, gnu_decl, false);
saved = true;
- if (defer_incomplete_level == 0
- && ! (is_from_limited_with
- && (in_main_unit
- || In_Extended_Main_Code_Unit (gnat_entity))))
- update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
- gnat_to_gnu_type (gnat_desig_equiv));
-
- /* Note that the call to gnat_to_gnu_type here might have
- updated gnu_old_type directly, in which case it is not a
- dummy type any more when we get into update_pointer_to.
+ /* Note that the call to gnat_to_gnu_type on gnat_desig_equiv might
+ update gnu_old_desig_type directly, in which case it will not be
+ a dummy type any more when we get into update_pointer_to.
- This may happen for instance when the designated type is a
- record type, because their elaboration starts with an
- initial node from make_dummy_type, which may yield the same
- node as the one we got.
+ This can happen e.g. when the designated type is a record type,
+ because their elaboration starts with an initial node from
+ make_dummy_type, which may be the same node as the one we got.
- Besides, variants of this non-dummy type might have been
- created along the way. update_pointer_to is expected to
- properly take care of those situations. */
+ Besides, variants of this non-dummy type might have been created
+ along the way. update_pointer_to is expected to properly take
+ care of those situations. */
+ if (!defer_incomplete_level && !is_from_limited_with_in_main_unit)
+ update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type),
+ gnat_to_gnu_type (gnat_desig_equiv));
else
{
- struct incomplete *p
- = (struct incomplete *) xmalloc (sizeof
- (struct incomplete));
+ struct incomplete *p = XNEW (struct incomplete);
struct incomplete **head
- = (is_from_limited_with
- && (in_main_unit
- || In_Extended_Main_Code_Unit (gnat_entity))
+ = (is_from_limited_with_in_main_unit
? &defer_limited_with : &defer_incomplete_list);
-
- p->old_type = gnu_old_type;
+ p->old_type = gnu_old_desig_type;
p->full_type = gnat_desig_equiv;
p->next = *head;
*head = p;
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;
&& !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));
}
}
{
Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
Node_Id scalar_range;
- tree gnu_lb, gnu_hb, gnu_lb_minus_one;
+ tree gnu_lb, gnu_hb;
/* If the low bound is not constant, try to find an upper bound. */
while (Nkind (gnat_lb) != N_Integer_Literal
return (TREE_CODE (gnu_expr) == ADDR_EXPR
&& TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
}
+
+/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR. */
+
+static bool
+constructor_address_p (tree gnu_expr)
+{
+ while (TREE_CODE (gnu_expr) == NOP_EXPR
+ || TREE_CODE (gnu_expr) == CONVERT_EXPR
+ || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR)
+ gnu_expr = TREE_OPERAND (gnu_expr, 0);
+
+ return (TREE_CODE (gnu_expr) == ADDR_EXPR
+ && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
+}
\f
/* Given GNAT_ENTITY, elaborate all expressions that are required to
be elaborated at the point of its definition, but do nothing else. */
if (TREE_CODE (name) == TYPE_DECL)
name = DECL_NAME (name);
-
- TYPE_NAME (record_type) = concat_name (name, "_ALIGN");
+ name = concat_name (name, "ALIGN");
+ TYPE_NAME (record_type) = name;
/* Compute VOFFSET and then POS. The next byte position multiple of some
alignment after some address is obtained by "and"ing the alignment minus
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;
size_int (room + align / BITS_PER_UNIT));
SET_TYPE_MODE (record_type, BLKmode);
-
relate_alias_sets (record_type, type, ALIAS_SET_COPY);
+
+ /* Declare it now since it will never be declared otherwise. This is
+ necessary to ensure that its subtrees are properly marked. */
+ create_type_decl (name, record_type, NULL, true, false, Empty);
+
return record_type;
}
\f
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_TO_FIELD (new_field, old_field);
}
/* 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 emit debug info until after the auxiliary record is built. */
finish_record_type (marker,
create_field_decl (orig_name,
build_reference_type (type),
- marker, 0, NULL_TREE, NULL_TREE,
- 0),
+ marker, NULL_TREE, NULL_TREE,
+ 0, 0),
0, true);
add_parallel_type (TYPE_STUB_DECL (record), marker);
if (definition && size && TREE_CODE (size) != INTEGER_CST)
- create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
- TYPE_SIZE_UNIT (record), false, false, false,
- false, NULL, gnat_entity);
+ 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);
|| !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);
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;
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;
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);
}
TCode tcode;
Node_Ref_Or_Val ops[3], ret;
struct tree_int_map **h = NULL;
- int i;
+ int size, i;
/* See if we've already saved the value for this node. */
if (EXPR_P (gnu_size))
this is in bitsizetype. */
gnu_size = convert (bitsizetype, gnu_size);
- /* For a negative value, use NEGATE_EXPR of the opposite. Such values
- appear in expressions containing aligning patterns. */
- 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)
{
tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
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. */
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);
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)
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);
OSDN Git Service
