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);
- /* 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)))
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. */
}
}
- /* 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);
= 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
(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_IS_FAT_POINTER_P (gnu_type))
- && !Is_Imported (gnat_entity) && !gnu_expr)
+ && !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);
(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),
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))))
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 a constant, even if we don't need a true variable, we
if (TREE_CODE (gnu_decl) == CONST_DECL)
DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
- /* If this is declared in a block that contains a block with an
- exception handler, we must force this variable in memory to
- suppress an invalid optimization. */
- if (Has_Nested_Block_With_Handler (Scope (gnat_entity))
- && Exception_Mechanism != Back_End_Exceptions)
+ /* 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
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, 0,
+ NULL_TREE, NULL_TREE, 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, 0,
+ NULL_TREE, NULL_TREE, 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. */
/* 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
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"));
shift_unc_components_for_thin_pointers (tem);
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;
}
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);
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. */
{
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. */
/* 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);
TYPE_FIELDS (record_type) = field;
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);
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;
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;
TCode tcode;
Node_Ref_Or_Val ops[3], ret;
struct tree_int_map **h = NULL;
- int size, i;
+ 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. */
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
|| Ekind (gnat_object) == E_Discriminant)
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. */
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. */
gnat_attr_node
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);
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;
OSDN Git Service
