From 772fcf4769a4d4e5546039c0174662df1bc86fa4 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 17 Jun 2024 09:54:47 +0200 Subject: [PATCH] ada: Call memcmp instead of Compare_Array_Unsigned_8 and... ... implement support for ordering comparisons of discrete array types. This extends the Support_Composite_Compare_On_Target feature to ordering comparisons of discrete array types as specified by RM 4.5.2(26/3), when the component type is a byte (unsigned). Implement support for ordering comparisons of discrete array types with a two-pronged approach: for types with a size known at compile time, this lets the gimplifier generate the call to memcmp (or else an optimize version of it); otherwise, this directly generates the call to memcmp. gcc/ada/ * exp_ch4.adb (Expand_Array_Comparison): Remove the obsolete byte addressibility test. If Support_Composite_Compare_On_Target is true, immediately return for a component size of 8, an unsigned component type and aligned operands. Disable when Unnest_Subprogram_Mode is true (for LLVM). (Expand_N_Op_Eq): Adjust comment. * targparm.ads (Support_Composite_Compare_On_Target): Replace bit by byte in description and document support for ordering comparisons. * gcc-interface/utils2.cc (compare_arrays): Rename into... (compare_arrays_for_equality): ...this. Remove redundant lines. (compare_arrays_for_ordering): New function. (build_binary_op) : Call compare_arrays_for_ordering to implement ordering comparisons for arrays. --- gcc/ada/exp_ch4.adb | 41 ++++++----- gcc/ada/gcc-interface/utils2.cc | 122 ++++++++++++++++++++++++++++---- gcc/ada/targparm.ads | 11 +-- 3 files changed, 138 insertions(+), 36 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6a33734c443..e4c9de474ad 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 -- 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; + -- Expand to a call only if the runtime function is available, + -- otherwise fall back to inline code. + if RTE_Available (Comp) then - - -- Expand to a call only if the runtime function is available, - -- otherwise fall back to inline code. - 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. diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index d101d7729bf..0d7e03ec6b0 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -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; } diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 050eb25c12c..323a41dcc8b 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -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