Commit 683ccd05 by Eric Botcazou Committed by Eric Botcazou

repinfo.adb (List_Component_Layout): Remove superfluous space for zero-sized field.

	* repinfo.adb (List_Component_Layout): Remove superfluous space for
	zero-sized field.
	* gcc-interface/ada-tree.h (TYPE_IS_EXTRA_SUBTYPE_P): New macro.
	* gcc-interface/gigi.h (create_extra_subtype): Declare.
	* gcc-interface/decl.c (TYPE_ARRAY_SIZE_LIMIT): Likewise.
	(update_n_elem): New function.
	(gnat_to_gnu_entity): Use create_extra_subtype to create extra subtypes
	instead of doing it manually.
	<E_Array_Type>: Use update_n_elem to compute the maximum size.  Use the
 	index type instead of base type for the bounds. Set TYPE_ARRAY_MAX_SIZE
	of the array to the maximum size.
	<E_Array_Subtype>: Create an extra subtype using the index type of the
	base array type for self-referential bounds.  Use update_n_elem to
	compute the maximum size.  Set TYPE_ARRAY_MAX_SIZE of the array to the
	maximum size.
	(gnat_to_gnu_field): Clear DECL_NONADDRESSABLE_P on discriminants.
	* gcc-interface/misc.c (gnat_get_alias_set): Return the alias set of
	the base type for an extra subtype.
	(gnat_type_max_size): Remove obsolete code.
	* gcc-interface/trans.c (Attribute_to_gnu): Minor tweak.
	(can_be_lower_p): Deal with pathological types.
	* gcc-interface/utils.c (create_extra_subtype): New function.
	(create_field_decl): Minor tweak.
	(max_size) <tcc_reference>: Compute a better value by using the extra
 	subtypes on the self-referential bounds.
	<tcc_binary>: Rewrite.  Deal with "negative value" in unsigned types.
	<tcc_expression>: Likewise.
	* gcc-interface/utils2.c (compare_arrays): Retrieve the original bounds
	of the arrays upfront.  Swap only if the second length is not constant.
	Use comparisons on the original bounds consistently for the null tests.
	(build_binary_op): Use TYPE_IS_EXTRA_SUBTYPE_P macro.
	(build_allocator): Minor tweak.

From-SVN: r268318
parent 33731c66
2019-01-27 Eric Botcazou <ebotcazou@adacore.com> 2019-01-27 Eric Botcazou <ebotcazou@adacore.com>
* repinfo.adb (List_Component_Layout): Remove superfluous space for
zero-sized field.
* gcc-interface/ada-tree.h (TYPE_IS_EXTRA_SUBTYPE_P): New macro.
* gcc-interface/gigi.h (create_extra_subtype): Declare.
* gcc-interface/decl.c (TYPE_ARRAY_SIZE_LIMIT): Likewise.
(update_n_elem): New function.
(gnat_to_gnu_entity): Use create_extra_subtype to create extra subtypes
instead of doing it manually.
<E_Array_Type>: Use update_n_elem to compute the maximum size. Use the
index type instead of base type for the bounds. Set TYPE_ARRAY_MAX_SIZE
of the array to the maximum size.
<E_Array_Subtype>: Create an extra subtype using the index type of the
base array type for self-referential bounds. Use update_n_elem to
compute the maximum size. Set TYPE_ARRAY_MAX_SIZE of the array to the
maximum size.
(gnat_to_gnu_field): Clear DECL_NONADDRESSABLE_P on discriminants.
* gcc-interface/misc.c (gnat_get_alias_set): Return the alias set of
the base type for an extra subtype.
(gnat_type_max_size): Remove obsolete code.
* gcc-interface/trans.c (Attribute_to_gnu): Minor tweak.
(can_be_lower_p): Deal with pathological types.
* gcc-interface/utils.c (create_extra_subtype): New function.
(create_field_decl): Minor tweak.
(max_size) <tcc_reference>: Compute a better value by using the extra
subtypes on the self-referential bounds.
<tcc_binary>: Rewrite. Deal with "negative value" in unsigned types.
<tcc_expression>: Likewise.
* gcc-interface/utils2.c (compare_arrays): Retrieve the original bounds
of the arrays upfront. Swap only if the second length is not constant.
Use comparisons on the original bounds consistently for the null tests.
(build_binary_op): Use TYPE_IS_EXTRA_SUBTYPE_P macro.
(build_allocator): Minor tweak.
2019-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (array_type_has_nonaliased_component): Return * gcc-interface/decl.c (array_type_has_nonaliased_component): Return
the same value for every dimension of a multidimensional array type. the same value for every dimension of a multidimensional array type.
......
...@@ -111,6 +111,9 @@ do { \ ...@@ -111,6 +111,9 @@ do { \
front-end. */ front-end. */
#define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (INTEGER_TYPE_CHECK (NODE)) #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (INTEGER_TYPE_CHECK (NODE))
#define TYPE_IS_EXTRA_SUBTYPE_P(NODE) \
(TREE_CODE (NODE) == INTEGER_TYPE && TYPE_EXTRA_SUBTYPE_P (NODE))
/* Nonzero for an aggregate type if this is a by-reference type. We also /* Nonzero for an aggregate type if this is a by-reference type. We also
set this on an ENUMERAL_TYPE that is dummy. */ set this on an ENUMERAL_TYPE that is dummy. */
#define TYPE_BY_REFERENCE_P(NODE) \ #define TYPE_BY_REFERENCE_P(NODE) \
......
...@@ -637,6 +637,9 @@ extern tree create_index_type (tree min, tree max, tree index, ...@@ -637,6 +637,9 @@ extern tree create_index_type (tree min, tree max, tree index,
sizetype is used. */ sizetype is used. */
extern tree create_range_type (tree type, tree min, tree max); extern tree create_range_type (tree type, tree min, tree max);
/* Return an extra subtype of TYPE with range MIN to MAX. */
extern tree create_extra_subtype (tree type, tree min, tree max);
/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE. /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE.
NAME gives the name of the type to be used in the declaration. */ NAME gives the name of the type to be used in the declaration. */
extern tree create_type_stub_decl (tree name, tree type); extern tree create_type_stub_decl (tree name, tree type);
......
...@@ -727,6 +727,10 @@ gnat_get_alias_set (tree type) ...@@ -727,6 +727,10 @@ gnat_get_alias_set (tree type)
if (TYPE_IS_PADDING_P (type)) if (TYPE_IS_PADDING_P (type))
return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
/* If this is an extra subtype, use the base type. */
else if (TYPE_IS_EXTRA_SUBTYPE_P (type))
return get_alias_set (get_base_type (type));
/* If the type is an unconstrained array, use the type of the /* If the type is an unconstrained array, use the type of the
self-referential array we make. */ self-referential array we make. */
else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
...@@ -753,59 +757,22 @@ gnat_type_max_size (const_tree gnu_type) ...@@ -753,59 +757,22 @@ gnat_type_max_size (const_tree gnu_type)
elaborated and possibly replaced by a VAR_DECL. */ elaborated and possibly replaced by a VAR_DECL. */
tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true); tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
/* If we don't have a constant, try to look at attributes which should have /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
stayed untouched. */ which should stay untouched. */
if (!tree_fits_uhwi_p (max_size_unit)) if (!tree_fits_uhwi_p (max_size_unit)
&& RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
&& TYPE_ADA_SIZE (gnu_type))
{ {
/* For record types, see what we can get from TYPE_ADA_SIZE. */ tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type) /* If we have succeeded in finding a constant, round it up to the
&& TYPE_ADA_SIZE (gnu_type)) type's alignment and return the result in units. */
{ if (tree_fits_uhwi_p (max_ada_size))
tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true); max_size_unit
= size_binop (CEIL_DIV_EXPR,
/* If we have succeeded in finding a constant, round it up to the round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
type's alignment and return the result in units. */ bitsize_unit_node);
if (tree_fits_uhwi_p (max_ada_size))
max_size_unit
= size_binop (CEIL_DIV_EXPR,
round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
bitsize_unit_node);
}
/* For array types, see what we can get from TYPE_INDEX_TYPE. */
else if (TREE_CODE (gnu_type) == ARRAY_TYPE
&& TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))
&& tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))))
{
tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
tree hb = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
if (TREE_CODE (lb) != INTEGER_CST
&& TYPE_RM_SIZE (TREE_TYPE (lb))
&& compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (lb)), 16) <= 0)
lb = TYPE_MIN_VALUE (TREE_TYPE (lb));
if (TREE_CODE (hb) != INTEGER_CST
&& TYPE_RM_SIZE (TREE_TYPE (hb))
&& compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (hb)), 16) <= 0)
hb = TYPE_MAX_VALUE (TREE_TYPE (hb));
if (TREE_CODE (lb) == INTEGER_CST && TREE_CODE (hb) == INTEGER_CST)
{
tree ctype = get_base_type (TREE_TYPE (lb));
lb = fold_convert (ctype, lb);
hb = fold_convert (ctype, hb);
if (tree_int_cst_le (lb, hb))
{
tree length
= fold_build2 (PLUS_EXPR, ctype,
fold_build2 (MINUS_EXPR, ctype, hb, lb),
build_int_cst (ctype, 1));
max_size_unit
= fold_build2 (MULT_EXPR, sizetype,
fold_convert (sizetype, length),
TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
}
}
}
} }
return max_size_unit; return max_size_unit;
......
...@@ -2374,15 +2374,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -2374,15 +2374,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
else else
gnu_result = rm_size (gnu_type); gnu_result = rm_size (gnu_type);
/* Deal with a self-referential size by returning the maximum size for /* Deal with a self-referential size by qualifying the size with the
a type and by qualifying the size with the object otherwise. */ object or returning the maximum size for a type. */
if (CONTAINS_PLACEHOLDER_P (gnu_result)) if (TREE_CODE (gnu_prefix) != TYPE_DECL)
{ gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_expr);
if (TREE_CODE (gnu_prefix) == TYPE_DECL) else if (CONTAINS_PLACEHOLDER_P (gnu_result))
gnu_result = max_size (gnu_result, true); gnu_result = max_size (gnu_result, true);
else
gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
}
/* If the type contains a template, subtract the padded size of the /* If the type contains a template, subtract the padded size of the
template, except for 'Max_Size_In_Storage_Elements because we need template, except for 'Max_Size_In_Storage_Elements because we need
...@@ -3227,13 +3224,25 @@ static bool ...@@ -3227,13 +3224,25 @@ static bool
can_be_lower_p (tree val1, tree val2) can_be_lower_p (tree val1, tree val2)
{ {
if (TREE_CODE (val1) == NOP_EXPR) if (TREE_CODE (val1) == NOP_EXPR)
val1 = TYPE_MIN_VALUE (TREE_TYPE (TREE_OPERAND (val1, 0))); {
tree type = TREE_TYPE (TREE_OPERAND (val1, 0));
if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type)))
return true;
val1 = TYPE_MIN_VALUE (type);
}
if (TREE_CODE (val1) != INTEGER_CST) if (TREE_CODE (val1) != INTEGER_CST)
return true; return true;
if (TREE_CODE (val2) == NOP_EXPR) if (TREE_CODE (val2) == NOP_EXPR)
val2 = TYPE_MAX_VALUE (TREE_TYPE (TREE_OPERAND (val2, 0))); {
tree type = TREE_TYPE (TREE_OPERAND (val2, 0));
if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type)))
return true;
val2 = TYPE_MAX_VALUE (type);
}
if (TREE_CODE (val2) != INTEGER_CST) if (TREE_CODE (val2) != INTEGER_CST)
return true; return true;
......
...@@ -2260,7 +2260,7 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, ...@@ -2260,7 +2260,7 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
1, has_rep)); 1, has_rep));
/* We don't need any NON_VALUE_EXPRs and they can confuse us (especially /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
when fed through substitute_in_expr) into thinking that a constant when fed through SUBSTITUTE_IN_EXPR) into thinking that a constant
size is not constant. */ size is not constant. */
while (TREE_CODE (new_size) == NON_LVALUE_EXPR) while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
new_size = TREE_OPERAND (new_size, 0); new_size = TREE_OPERAND (new_size, 0);
...@@ -2429,6 +2429,24 @@ create_range_type (tree type, tree min, tree max) ...@@ -2429,6 +2429,24 @@ create_range_type (tree type, tree min, tree max)
return range_type; return range_type;
} }
/* Return an extra subtype of TYPE with range MIN to MAX. */
tree
create_extra_subtype (tree type, tree min, tree max)
{
const bool uns = TYPE_UNSIGNED (type);
const unsigned prec = TYPE_PRECISION (type);
tree subtype = uns ? make_unsigned_type (prec) : make_signed_type (prec);
TREE_TYPE (subtype) = type;
TYPE_EXTRA_SUBTYPE_P (subtype) = 1;
SET_TYPE_RM_MIN_VALUE (subtype, min);
SET_TYPE_RM_MAX_VALUE (subtype, max);
return subtype;
}
/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE. /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE.
NAME gives the name of the type to be used in the declaration. */ NAME gives the name of the type to be used in the declaration. */
...@@ -2811,8 +2829,8 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos, ...@@ -2811,8 +2829,8 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
layout_decl (field_decl, known_align); layout_decl (field_decl, known_align);
SET_DECL_OFFSET_ALIGN (field_decl, SET_DECL_OFFSET_ALIGN (field_decl,
tree_fits_uhwi_p (pos) ? BIGGEST_ALIGNMENT tree_fits_uhwi_p (pos)
: BITS_PER_UNIT); ? BIGGEST_ALIGNMENT : BITS_PER_UNIT);
pos_from_bit (&DECL_FIELD_OFFSET (field_decl), pos_from_bit (&DECL_FIELD_OFFSET (field_decl),
&DECL_FIELD_BIT_OFFSET (field_decl), &DECL_FIELD_BIT_OFFSET (field_decl),
DECL_OFFSET_ALIGN (field_decl), pos); DECL_OFFSET_ALIGN (field_decl), pos);
...@@ -2829,6 +2847,15 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos, ...@@ -2829,6 +2847,15 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
if (!addressable && !type_for_nonaliased_component_p (type)) if (!addressable && !type_for_nonaliased_component_p (type))
addressable = 1; addressable = 1;
/* Note that there is a trade-off in making a field nonaddressable because
this will cause type-based alias analysis to use the same alias set for
accesses to the field as for accesses to the whole record: while doing
so will make it more likely to disambiguate accesses to other objects
and accesses to the field, it will make it less likely to disambiguate
accesses to the other fields of the record and accesses to the field.
If the record is fully static, then the trade-off is irrelevant since
the fields of the record can always be disambiguated by their offsets
but, if the record is dynamic, then it can become problematic. */
DECL_NONADDRESSABLE_P (field_decl) = !addressable; DECL_NONADDRESSABLE_P (field_decl) = !addressable;
return field_decl; return field_decl;
...@@ -3658,11 +3685,27 @@ max_size (tree exp, bool max_p) ...@@ -3658,11 +3685,27 @@ max_size (tree exp, bool max_p)
modify. Otherwise, we treat it like a variable. */ modify. Otherwise, we treat it like a variable. */
if (CONTAINS_PLACEHOLDER_P (exp)) if (CONTAINS_PLACEHOLDER_P (exp))
{ {
tree val_type = TREE_TYPE (TREE_OPERAND (exp, 1)); tree base_type = get_base_type (TREE_TYPE (TREE_OPERAND (exp, 1)));
tree val = (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type)); tree val
return = fold_convert (base_type,
convert (type, max_p
max_size (convert (get_base_type (val_type), val), true)); ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
/* Walk down the extra subtypes to get more restrictive bounds. */
while (TYPE_IS_EXTRA_SUBTYPE_P (type))
{
type = TREE_TYPE (type);
if (max_p)
val = fold_build2 (MIN_EXPR, base_type, val,
fold_convert (base_type,
TYPE_MAX_VALUE (type)));
else
val = fold_build2 (MAX_EXPR, base_type, val,
fold_convert (base_type,
TYPE_MIN_VALUE (type)));
}
return fold_convert (type, max_size (val, max_p));
} }
return exp; return exp;
...@@ -3683,49 +3726,57 @@ max_size (tree exp, bool max_p) ...@@ -3683,49 +3726,57 @@ max_size (tree exp, bool max_p)
return fold_build1 (code, type, op0); return fold_build1 (code, type, op0);
case tcc_binary: case tcc_binary:
{ op0 = TREE_OPERAND (exp, 0);
tree lhs = max_size (TREE_OPERAND (exp, 0), max_p); op1 = TREE_OPERAND (exp, 1);
tree rhs = max_size (TREE_OPERAND (exp, 1),
code == MINUS_EXPR ? !max_p : max_p); /* If we have a multiply-add with a "negative" value in an unsigned
type, do a multiply-subtract with the negated value, in order to
avoid creating a spurious overflow below. */
if (code == PLUS_EXPR
&& TREE_CODE (op0) == MULT_EXPR
&& TYPE_UNSIGNED (type)
&& TREE_CODE (TREE_OPERAND (op0, 1)) == INTEGER_CST
&& !TREE_OVERFLOW (TREE_OPERAND (op0, 1))
&& tree_int_cst_sign_bit (TREE_OPERAND (op0, 1)))
{
tree tmp = op1;
op1 = build2 (MULT_EXPR, type, TREE_OPERAND (op0, 0),
fold_build1 (NEGATE_EXPR, type,
TREE_OPERAND (op0, 1)));
op0 = tmp;
code = MINUS_EXPR;
}
/* Special-case wanting the maximum value of a MIN_EXPR. op0 = max_size (op0, max_p);
In that case, if one side overflows, return the other. */ op1 = max_size (op1, code == MINUS_EXPR ? !max_p : max_p);
if (max_p && code == MIN_EXPR)
{
if (TREE_CODE (rhs) == INTEGER_CST && TREE_OVERFLOW (rhs))
return lhs;
if (TREE_CODE (lhs) == INTEGER_CST && TREE_OVERFLOW (lhs)) if ((code == MINUS_EXPR || code == PLUS_EXPR))
return rhs; {
} /* If the op0 has overflowed and the op1 is a variable,
propagate the overflow by returning the op0. */
/* Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS if (TREE_CODE (op0) == INTEGER_CST
overflowing and the RHS a variable. */ && TREE_OVERFLOW (op0)
if ((code == MINUS_EXPR || code == PLUS_EXPR) && TREE_CODE (op1) != INTEGER_CST)
&& TREE_CODE (lhs) == INTEGER_CST return op0;
&& TREE_OVERFLOW (lhs)
&& TREE_CODE (rhs) != INTEGER_CST) /* If we have a "negative" value in an unsigned type, do the
return lhs; opposite operation on the negated value, in order to avoid
creating a spurious overflow below. */
/* If we are going to subtract a "negative" value in an unsigned type, if (TYPE_UNSIGNED (type)
do the operation as an addition of the negated value, in order to && TREE_CODE (op1) == INTEGER_CST
avoid creating a spurious overflow below. */ && !TREE_OVERFLOW (op1)
if (code == MINUS_EXPR && tree_int_cst_sign_bit (op1))
&& TYPE_UNSIGNED (type) {
&& TREE_CODE (rhs) == INTEGER_CST op1 = fold_build1 (NEGATE_EXPR, type, op1);
&& !TREE_OVERFLOW (rhs) code = (code == MINUS_EXPR ? PLUS_EXPR : MINUS_EXPR);
&& tree_int_cst_sign_bit (rhs) != 0) }
{ }
rhs = fold_build1 (NEGATE_EXPR, type, rhs);
code = PLUS_EXPR;
}
if (lhs == TREE_OPERAND (exp, 0) && rhs == TREE_OPERAND (exp, 1)) if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
return exp; return exp;
/* We need to detect overflows so we call size_binop here. */ /* We need to detect overflows so we call size_binop here. */
return size_binop (code, lhs, rhs); return size_binop (code, op0, op1);
}
case tcc_expression: case tcc_expression:
switch (TREE_CODE_LENGTH (code)) switch (TREE_CODE_LENGTH (code))
...@@ -3757,15 +3808,28 @@ max_size (tree exp, bool max_p) ...@@ -3757,15 +3808,28 @@ max_size (tree exp, bool max_p)
case 3: case 3:
if (code == COND_EXPR) if (code == COND_EXPR)
{ {
op0 = TREE_OPERAND (exp, 0);
op1 = TREE_OPERAND (exp, 1); op1 = TREE_OPERAND (exp, 1);
op2 = TREE_OPERAND (exp, 2); op2 = TREE_OPERAND (exp, 2);
if (!op1 || !op2) if (!op1 || !op2)
return exp; return exp;
return op1 = max_size (op1, max_p);
fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, op2 = max_size (op2, max_p);
max_size (op1, max_p), max_size (op2, max_p));
/* If we have the MAX of a "negative" value in an unsigned type
and zero for a length expression, just return zero. */
if (max_p
&& TREE_CODE (op0) == LE_EXPR
&& TYPE_UNSIGNED (type)
&& TREE_CODE (op1) == INTEGER_CST
&& !TREE_OVERFLOW (op1)
&& tree_int_cst_sign_bit (op1)
&& integer_zerop (op2))
return op2;
return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, op1, op2);
} }
break; break;
......
...@@ -301,19 +301,31 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) ...@@ -301,19 +301,31 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
in order to suppress the comparison of the data at the end. */ in order to suppress the comparison of the data at the end. */
while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE) while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE)
{ {
tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1)); tree dom1 = TYPE_DOMAIN (t1);
tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1)); tree dom2 = TYPE_DOMAIN (t2);
tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2)); tree length1 = size_binop (PLUS_EXPR,
tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2)); size_binop (MINUS_EXPR,
tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1), TYPE_MAX_VALUE (dom1),
TYPE_MIN_VALUE (dom1)),
size_one_node); size_one_node);
tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2), tree length2 = size_binop (PLUS_EXPR,
size_binop (MINUS_EXPR,
TYPE_MAX_VALUE (dom2),
TYPE_MIN_VALUE (dom2)),
size_one_node); size_one_node);
tree ind1 = TYPE_INDEX_TYPE (dom1);
tree ind2 = TYPE_INDEX_TYPE (dom2);
tree base_type = maybe_character_type (get_base_type (ind1));
tree lb1 = convert (base_type, TYPE_MIN_VALUE (ind1));
tree ub1 = convert (base_type, TYPE_MAX_VALUE (ind1));
tree lb2 = convert (base_type, TYPE_MIN_VALUE (ind2));
tree ub2 = convert (base_type, TYPE_MAX_VALUE (ind2));
tree comparison, this_a1_is_null, this_a2_is_null; tree comparison, this_a1_is_null, this_a2_is_null;
/* If the length of the first array is a constant, swap our operands /* If the length of the first array is a constant and that of the second
unless the length of the second array is the constant zero. */ array is not, swap our operands to have the constant second. */
if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2)) if (TREE_CODE (length1) == INTEGER_CST
&& TREE_CODE (length2) != INTEGER_CST)
{ {
tree tem; tree tem;
bool btem; bool btem;
...@@ -333,17 +345,12 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) ...@@ -333,17 +345,12 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
last < first holds. */ last < first holds. */
if (integer_zerop (length2)) if (integer_zerop (length2))
{ {
tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
length_zero_p = true; length_zero_p = true;
ub1 lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)))); ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
lb1
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1); comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
if (EXPR_P (comparison)) if (EXPR_P (comparison))
SET_EXPR_LOCATION (comparison, loc); SET_EXPR_LOCATION (comparison, loc);
...@@ -356,24 +363,17 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) ...@@ -356,24 +363,17 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
just use its length computed from the actual stored bounds. */ just use its length computed from the actual stored bounds. */
else if (TREE_CODE (length2) == INTEGER_CST) else if (TREE_CODE (length2) == INTEGER_CST)
{ {
tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))); /* Note that we know that LB2 and UB2 are constant and hence
ub1
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
lb1
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
/* Note that we know that UB2 and LB2 are constant and hence
cannot contain a PLACEHOLDER_EXPR. */ cannot contain a PLACEHOLDER_EXPR. */
ub2 lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)))); ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
lb2
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2))));
comparison comparison
= fold_build2_loc (loc, EQ_EXPR, result_type, = fold_build2_loc (loc, EQ_EXPR, result_type,
build_binary_op (MINUS_EXPR, b, ub1, lb1), build_binary_op (MINUS_EXPR, base_type,
build_binary_op (MINUS_EXPR, b, ub2, lb2)); ub1, lb1),
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1); build_binary_op (MINUS_EXPR, base_type,
ub2, lb2));
if (EXPR_P (comparison)) if (EXPR_P (comparison))
SET_EXPR_LOCATION (comparison, loc); SET_EXPR_LOCATION (comparison, loc);
...@@ -391,26 +391,20 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) ...@@ -391,26 +391,20 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
comparison comparison
= fold_build2_loc (loc, EQ_EXPR, result_type, length1, length2); = fold_build2_loc (loc, EQ_EXPR, result_type, length1, length2);
if (EXPR_P (comparison))
SET_EXPR_LOCATION (comparison, loc);
/* If the length expression is of the form (cond ? val : 0), assume lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
that cond is equivalent to (length != 0). That's guaranteed by ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
construction of the array types in gnat_to_gnu_entity. */
if (TREE_CODE (length1) == COND_EXPR this_a1_is_null
&& integer_zerop (TREE_OPERAND (length1, 2))) = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
this_a1_is_null
= invert_truthvalue_loc (loc, TREE_OPERAND (length1, 0)); lb2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb2, a2);
else ub2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub2, a2);
this_a1_is_null = fold_build2_loc (loc, EQ_EXPR, result_type,
length1, size_zero_node); this_a2_is_null
= fold_build2_loc (loc, LT_EXPR, result_type, ub2, lb2);
/* Likewise for the second array. */
if (TREE_CODE (length2) == COND_EXPR
&& integer_zerop (TREE_OPERAND (length2, 2)))
this_a2_is_null
= invert_truthvalue_loc (loc, TREE_OPERAND (length2, 0));
else
this_a2_is_null = fold_build2_loc (loc, EQ_EXPR, result_type,
length2, size_zero_node);
} }
/* Append expressions for this dimension to the final expressions. */ /* Append expressions for this dimension to the final expressions. */
...@@ -861,9 +855,7 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -861,9 +855,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
&& TYPE_JUSTIFIED_MODULAR_P (operation_type)) && TYPE_JUSTIFIED_MODULAR_P (operation_type))
operation_type = TREE_TYPE (TYPE_FIELDS (operation_type)); operation_type = TREE_TYPE (TYPE_FIELDS (operation_type));
if (operation_type if (operation_type && TYPE_IS_EXTRA_SUBTYPE_P (operation_type))
&& TREE_CODE (operation_type) == INTEGER_TYPE
&& TYPE_EXTRA_SUBTYPE_P (operation_type))
operation_type = get_base_type (operation_type); operation_type = get_base_type (operation_type);
modulus = (operation_type modulus = (operation_type
...@@ -2431,16 +2423,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -2431,16 +2423,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
size = TYPE_SIZE_UNIT (TREE_TYPE (init)); size = TYPE_SIZE_UNIT (TREE_TYPE (init));
/* If the size is still self-referential, reference the initializing /* If the size is still self-referential, reference the initializing
expression, if it is present. If not, this must have been a expression, if it is present. If not, this must have been a call
call to allocate a library-level object, in which case we use to allocate a library-level object, in which case we just use the
the maximum size. */ maximum size. */
if (CONTAINS_PLACEHOLDER_P (size)) if (!ignore_init_type && init)
{ size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init);
if (!ignore_init_type && init) else if (CONTAINS_PLACEHOLDER_P (size))
size = substitute_placeholder_in_expr (size, init); size = max_size (size, true);
else
size = max_size (size, true);
}
/* If the size overflows, pass -1 so Storage_Error will be raised. */ /* If the size overflows, pass -1 so Storage_Error will be raised. */
if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size)) if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size))
......
...@@ -1338,7 +1338,7 @@ package body Repinfo is ...@@ -1338,7 +1338,7 @@ package body Repinfo is
if List_Representation_Info_To_JSON then if List_Representation_Info_To_JSON then
UI_Write (Esiz); UI_Write (Esiz);
else else
if Lbit < 10 then if Lbit >= 0 and then Lbit < 10 then
Write_Char (' '); Write_Char (' ');
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment