@@ -1162,9 +1162,6 @@ package body Exp_Ch4 is
Comp : RE_Id;
- Byte_Addressable : constant Boolean := System_Storage_Unit = Byte'Size;
- -- True for byte addressable target
-
function Length_Less_Than_4 (Opnd : Node_Id) return Boolean;
-- Returns True if the length of the given operand is known to be less
-- than 4. Returns False if this length is known to be four or greater
@@ -1198,11 +1195,12 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Array_Comparison
begin
- -- Deal first with unpacked case, where we can call a runtime routine
- -- except that we avoid this for targets for which are not addressable
- -- by bytes.
+ -- Deal first with unpacked case, where we can call a runtime routine,
+ -- except if the component type is a byte (unsigned) where we can use
+ -- a byte-wise comparison if supported on the target (this is disabled
+ -- for now in Unnest_Subprogram_Mode for LLVM).
- if not Is_Bit_Packed_Array (Typ1) and then Byte_Addressable then
+ if not Is_Bit_Packed_Array (Typ1) then
-- The call we generate is:
-- Compare_Array_xn[_Unaligned]
@@ -1214,9 +1212,18 @@ package body Exp_Ch4 is
-- <op> is the standard comparison operator
if Component_Size (Typ1) = 8 then
- if Length_Less_Than_4 (Op1)
- or else
- Length_Less_Than_4 (Op2)
+ if Is_Unsigned_Type (Ctyp)
+ and then not Is_Possibly_Unaligned_Object (Op1)
+ and then not Is_Possibly_Unaligned_Slice (Op1)
+ and then not Is_Possibly_Unaligned_Object (Op2)
+ and then not Is_Possibly_Unaligned_Slice (Op2)
+ and then Support_Composite_Compare_On_Target
+ and then not Unnest_Subprogram_Mode
+ then
+ return;
+
+ elsif Length_Less_Than_4 (Op1)
+ or else Length_Less_Than_4 (Op2)
then
if Is_Unsigned_Type (Ctyp) then
Comp := RE_Compare_Array_U8_Unaligned;
@@ -1261,11 +1268,10 @@ package body Exp_Ch4 is
end if;
end if;
- if RTE_Available (Comp) then
-
- -- Expand to a call only if the runtime function is available,
- -- otherwise fall back to inline code.
+ -- Expand to a call only if the runtime function is available,
+ -- otherwise fall back to inline code.
+ if RTE_Available (Comp) then
Remove_Side_Effects (Op1, Name_Req => True);
Remove_Side_Effects (Op2, Name_Req => True);
@@ -1292,8 +1298,7 @@ package body Exp_Ch4 is
Attribute_Name => Name_Length)));
Zero : constant Node_Id :=
- Make_Integer_Literal (Loc,
- Intval => Uint_0);
+ Make_Integer_Literal (Loc, Intval => Uint_0);
Comp_Op : Node_Id;
@@ -8230,8 +8235,8 @@ package body Exp_Ch4 is
then
Expand_Packed_Eq (N);
- -- Where the component type is elementary we can use a block bit
- -- comparison (if supported on the target) exception in the case
+ -- When the component type is elementary, we can use a byte-wise
+ -- comparison if supported on the target, except in the cases
-- of floating-point (negative zero issues require element by
-- element comparison), and full access types (where we must be sure
-- to load elements independently) and possibly unaligned arrays.
@@ -283,7 +283,7 @@ find_common_type (tree t1, tree t2)
tests in as efficient a manner as possible. */
static tree
-compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
+compare_arrays_for_equality (location_t loc, tree result_type, tree a1, tree a2)
{
tree result = convert (result_type, boolean_true_node);
tree a1_is_null = convert (result_type, boolean_false_node);
@@ -357,8 +357,6 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, loc);
this_a1_is_null = comparison;
this_a2_is_null = convert (result_type, boolean_true_node);
@@ -380,9 +378,6 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
ub1, lb1),
build_binary_op (MINUS_EXPR, base_type,
ub2, lb2));
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, loc);
-
this_a1_is_null
= fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
@@ -397,8 +392,6 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
comparison
= fold_build2_loc (loc, EQ_EXPR, result_type, length1, length2);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, loc);
lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
@@ -464,6 +457,89 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
return result;
}
+/* Return an expression tree representing an ordering comparison of A1 and A2,
+ two objects of type ARRAY_TYPE. The result should be of type RESULT_TYPE.
+
+ A1 is less than A2 according to the following alternative:
+ - when A1's length is less than A2'length: if every element of A1 is equal
+ to its counterpart in A2 or the first differing is lesser in A1 than A2,
+ - otherwise: if not every element of A2 is equal to its counterpart in A1
+ and the first differing is lesser in A1 than A2.
+
+ The other 3 ordering comparisons can be easily deduced from this one. */
+
+static tree
+compare_arrays_for_ordering (location_t loc, tree result_type, tree a1, tree a2)
+{
+ const bool a1_side_effects_p = TREE_SIDE_EFFECTS (a1);
+ const bool a2_side_effects_p = TREE_SIDE_EFFECTS (a2);
+ tree t1 = TREE_TYPE (a1);
+ tree t2 = TREE_TYPE (a2);
+ tree dom1 = TYPE_DOMAIN (t1);
+ tree dom2 = TYPE_DOMAIN (t2);
+ tree length1 = size_binop (PLUS_EXPR,
+ size_binop (MINUS_EXPR,
+ TYPE_MAX_VALUE (dom1),
+ TYPE_MIN_VALUE (dom1)),
+ size_one_node);
+ tree length2 = size_binop (PLUS_EXPR,
+ size_binop (MINUS_EXPR,
+ TYPE_MAX_VALUE (dom2),
+ TYPE_MIN_VALUE (dom2)),
+ size_one_node);
+ tree addr1, addr2, fndecl, result;
+
+ /* If the lengths are known at compile time, fold the alternative and let the
+ gimplifier optimize the case of power-of-two lengths. */
+ if (TREE_CODE (length1) == INTEGER_CST && TREE_CODE (length2) == INTEGER_CST)
+ return tree_int_cst_compare (length1, length2) < 0
+ ? fold_build2_loc (loc, LE_EXPR, result_type, a1, convert (t1, a2))
+ : fold_build2_loc (loc, LT_EXPR, result_type, convert (t2, a1), a2);
+
+ /* If the operands have side-effects, they need to be evaluated only once
+ in spite of the multiple references in the comparison. */
+ if (a1_side_effects_p)
+ a1 = gnat_protect_expr (a1);
+
+ if (a2_side_effects_p)
+ a2 = gnat_protect_expr (a2);
+
+ length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
+ length2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length2, a2);
+
+ /* If the lengths are not known at compile time, call memcmp directly with
+ the actual lengths since a1 and a2 may have the same nominal subtype. */
+ addr1 = build_fold_addr_expr_loc (loc, a1);
+ addr2 = build_fold_addr_expr_loc (loc, a2);
+ fndecl = builtin_decl_implicit (BUILT_IN_MEMCMP);
+
+ result
+ = fold_build3_loc (loc, COND_EXPR, result_type,
+ fold_build2_loc (loc, LT_EXPR, boolean_type_node,
+ length1, length2),
+ fold_build2_loc (loc, LE_EXPR, result_type,
+ build_call_expr_loc (loc, fndecl, 3,
+ addr1, addr2,
+ length1),
+ integer_zero_node),
+ fold_build2_loc (loc, LT_EXPR, result_type,
+ build_call_expr_loc (loc, fndecl, 3,
+ addr1, addr2,
+ length2),
+ integer_zero_node));
+
+ /* If the operands have side-effects, they need to be evaluated before
+ doing the tests above since the place they otherwise would end up
+ being evaluated at run time could be wrong. */
+ if (a1_side_effects_p)
+ result = build2 (COMPOUND_EXPR, result_type, a1, result);
+
+ if (a2_side_effects_p)
+ result = build2 (COMPOUND_EXPR, result_type, a2, result);
+
+ return result;
+}
+
/* Return an expression tree representing an equality comparison of P1 and P2,
two objects of fat pointer type. The result should be of type RESULT_TYPE.
@@ -1176,12 +1252,32 @@ build_binary_op (enum tree_code op_code, tree result_type,
|| (TREE_CODE (right_type) == INTEGER_TYPE
&& TYPE_HAS_ACTUAL_BOUNDS_P (right_type))))
{
- result = compare_arrays (input_location,
- result_type, left_operand, right_operand);
- if (op_code == NE_EXPR)
- result = invert_truthvalue_loc (EXPR_LOCATION (result), result);
+ if (op_code == EQ_EXPR || op_code == NE_EXPR)
+ {
+ result
+ = compare_arrays_for_equality (input_location, result_type,
+ left_operand, right_operand);
+ if (op_code == NE_EXPR)
+ result = invert_truthvalue_loc (input_location, result);
+ }
+
else
- gcc_assert (op_code == EQ_EXPR);
+ {
+ /* Swap the operands to canonicalize to LT_EXPR or GE_EXPR. */
+ if (op_code == GT_EXPR || op_code == LE_EXPR)
+ result
+ = compare_arrays_for_ordering (input_location, result_type,
+ right_operand, left_operand);
+
+ else
+ result
+ = compare_arrays_for_ordering (input_location, result_type,
+ left_operand, right_operand);
+
+ /* GE_EXPR is (not LT_EXPR) for discrete array types. */
+ if (op_code == GE_EXPR || op_code == LE_EXPR)
+ result = invert_truthvalue_loc (input_location, result);
+ }
return result;
}
@@ -359,11 +359,12 @@ package Targparm is
-- the flag is set False, and composite assignments are not allowed.
Support_Composite_Compare_On_Target : Boolean := True;
- -- If this flag is True, then the back end supports bit-wise comparison
- -- of composite objects for equality, either generating inline code or
- -- calling appropriate (and available) run-time routines. If this flag
- -- is False, then the back end does not provide this support, and the
- -- front end uses component by component comparison for composites.
+ -- If this flag is True, then the back end supports byte-wise comparison
+ -- of arrays for equality operations and lexicographic comparison of 1-
+ -- dimensional arrays of bytes for ordering operations, either by means
+ -- of generating inline code or calling appropriate routines like memcmp.
+ -- If this flag is False, then the back end does not provide this support,
+ -- and the front end uses component by component comparison for arrays.
Support_Long_Shifts_On_Target : Boolean := True;
-- If True, the back end supports 64-bit shift operations. If False, then