[gcc r12-8723] fortran: Expand ieee_arithmetic module's ieee_class inline [PR106579]

[gcc r12-8723] fortran: Expand ieee_arithmetic module's ieee_class inline [PR106579]

[Jakub Jelinek]

https://gcc.gnu.org/g:c5d4e67e764fb157404142cfc8d2bc4436fcf0f5

commit r12-8723-gc5d4e67e764fb157404142cfc8d2bc4436fcf0f5
Author: Jakub Jelinek <jakub@redhat.com>
Date:   Fri Aug 26 09:52:02 2022 +0200

    fortran: Expand ieee_arithmetic module's ieee_class inline [PR106579]
    
    The following patch expands IEEE_CLASS inline in the FE but only for the
    powerpc64le-linux IEEE quad real(kind=16), using the __builtin_fpclassify
    builtin and explicit check of the MSB mantissa bit in place of missing
    __builtin_signbit builtin.
    
    2022-08-26  Jakub Jelinek  <jakub@redhat.com>
    
            PR fortran/106579
    gcc/fortran/
            * f95-lang.cc (gfc_init_builtin_functions): Initialize
            BUILT_IN_FPCLASSIFY.
            * libgfortran.h (IEEE_OTHER_VALUE, IEEE_SIGNALING_NAN,
            IEEE_QUIET_NAN, IEEE_NEGATIVE_INF, IEEE_NEGATIVE_NORMAL,
            IEEE_NEGATIVE_DENORMAL, IEEE_NEGATIVE_SUBNORMAL,
            IEEE_NEGATIVE_ZERO, IEEE_POSITIVE_ZERO, IEEE_POSITIVE_DENORMAL,
            IEEE_POSITIVE_SUBNORMAL, IEEE_POSITIVE_NORMAL, IEEE_POSITIVE_INF):
            New enum.
            * trans-intrinsic.cc (conv_intrinsic_ieee_class): New function.
            (gfc_conv_ieee_arithmetic_function): Handle ieee_class.
    libgfortran/
            * ieee/ieee_helper.c (IEEE_OTHER_VALUE, IEEE_SIGNALING_NAN,
            IEEE_QUIET_NAN, IEEE_NEGATIVE_INF, IEEE_NEGATIVE_NORMAL,
            IEEE_NEGATIVE_DENORMAL, IEEE_NEGATIVE_SUBNORMAL,
            IEEE_NEGATIVE_ZERO, IEEE_POSITIVE_ZERO, IEEE_POSITIVE_DENORMAL,
            IEEE_POSITIVE_SUBNORMAL, IEEE_POSITIVE_NORMAL, IEEE_POSITIVE_INF):
            Move to gcc/fortran/libgfortran.h.
    
    (cherry picked from commit db630423a97ec6690a8eb0e5c3cb186c91e3740d)

Diff:
---
 gcc/fortran/f95-lang.cc        |  3 +-
 gcc/fortran/libgfortran.h      | 20 +++++++++
 gcc/fortran/trans-intrinsic.cc | 94 ++++++++++++++++++++++++++++++++++++++++++
 libgfortran/ieee/ieee_helper.c | 20 ---------
 4 files changed, 116 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 1a895a25132..20c4a87c90b 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -1002,8 +1002,9 @@ gfc_init_builtin_functions (void)
 		      "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
   gfc_define_builtin ("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
 		      "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fpclassify", ftype, BUILT_IN_FPCLASSIFY,
+		      "__builtin_fpclassify", ATTR_CONST_NOTHROW_LEAF_LIST);
 
-  ftype = build_function_type (integer_type_node, NULL_TREE);
   gfc_define_builtin ("__builtin_isless", ftype, BUILT_IN_ISLESS,
 		      "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
   gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 064795eb469..81d1e340763 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -186,3 +186,23 @@ typedef enum
   BT_ASSUMED, BT_UNION, BT_BOZ
 }
 bt;
+
+/* Enumeration of the possible floating-point types. These values
+   correspond to the hidden arguments of the IEEE_CLASS_TYPE
+   derived-type of IEEE_ARITHMETIC.  */
+
+enum {
+  IEEE_OTHER_VALUE = 0,
+  IEEE_SIGNALING_NAN,
+  IEEE_QUIET_NAN,
+  IEEE_NEGATIVE_INF,
+  IEEE_NEGATIVE_NORMAL,
+  IEEE_NEGATIVE_DENORMAL,
+  IEEE_NEGATIVE_SUBNORMAL = IEEE_NEGATIVE_DENORMAL,
+  IEEE_NEGATIVE_ZERO,
+  IEEE_POSITIVE_ZERO,
+  IEEE_POSITIVE_DENORMAL,
+  IEEE_POSITIVE_SUBNORMAL = IEEE_POSITIVE_DENORMAL,
+  IEEE_POSITIVE_NORMAL,
+  IEEE_POSITIVE_INF
+};
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 2249723540d..6ed60846ff6 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -10008,6 +10008,98 @@ conv_intrinsic_ieee_copy_sign (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* Generate code for IEEE_CLASS.  */
+
+static bool
+conv_intrinsic_ieee_class (gfc_se *se, gfc_expr *expr)
+{
+  tree arg, c, t1, t2, t3, t4;
+
+  /* In GCC 12, handle inline only the powerpc64le-linux IEEE quad
+     real(kind=16) and nothing else.  */
+  if (gfc_type_abi_kind (&expr->value.function.actual->expr->ts) != 17)
+    return false;
+
+  /* Convert arg, evaluate it only once.  */
+  conv_ieee_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  c = build_call_expr_loc (input_location,
+			   builtin_decl_explicit (BUILT_IN_FPCLASSIFY), 6,
+			   build_int_cst (integer_type_node, IEEE_QUIET_NAN),
+			   build_int_cst (integer_type_node,
+					  IEEE_POSITIVE_INF),
+			   build_int_cst (integer_type_node,
+					  IEEE_POSITIVE_NORMAL),
+			   build_int_cst (integer_type_node,
+					  IEEE_POSITIVE_DENORMAL),
+			   build_int_cst (integer_type_node,
+					  IEEE_POSITIVE_ZERO),
+			   arg);
+  c = gfc_evaluate_now (c, &se->pre);
+  t1 = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			c, build_int_cst (integer_type_node,
+					  IEEE_QUIET_NAN));
+  /* In GCC 12, we don't have __builtin_issignaling but above we made
+     sure arg is powerpc64le-linux IEEE quad real(kind=16).
+     When we check it is some kind of NaN by fpclassify, all we need
+     is check the ((__int128) 1) << 111 bit, if it is zero, it is a sNaN,
+     if it is set, it is a qNaN.  */
+  t2 = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			build_nonstandard_integer_type (128, 1), arg);
+  t2 = fold_build2_loc (input_location, RSHIFT_EXPR, TREE_TYPE (t2), t2,
+			build_int_cst (integer_type_node, 111));
+  t2 = fold_convert (integer_type_node, t2);
+  t2 = fold_build2_loc (input_location, BIT_AND_EXPR, integer_type_node,
+			t2, integer_one_node);
+  t2 = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			t2, build_zero_cst (TREE_TYPE (t2)));
+  t1 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			logical_type_node, t1, t2);
+  t3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+			c, build_int_cst (integer_type_node,
+					  IEEE_POSITIVE_ZERO));
+  t4 = build_call_expr_loc (input_location,
+			    builtin_decl_explicit (BUILT_IN_SIGNBIT), 1,
+			    arg);
+  t4 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+			t4, build_zero_cst (TREE_TYPE (t4)));
+  t3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			logical_type_node, t3, t4);
+  int s = IEEE_NEGATIVE_ZERO + IEEE_POSITIVE_ZERO;
+  gcc_assert (IEEE_NEGATIVE_INF == s - IEEE_POSITIVE_INF);
+  gcc_assert (IEEE_NEGATIVE_NORMAL == s - IEEE_POSITIVE_NORMAL);
+  gcc_assert (IEEE_NEGATIVE_DENORMAL == s - IEEE_POSITIVE_DENORMAL);
+  gcc_assert (IEEE_NEGATIVE_SUBNORMAL == s - IEEE_POSITIVE_SUBNORMAL);
+  gcc_assert (IEEE_NEGATIVE_ZERO == s - IEEE_POSITIVE_ZERO);
+  t4 = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (c),
+			build_int_cst (TREE_TYPE (c), s), c);
+  t3 = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (c),
+			t3, t4, c);
+  t1 = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (c), t1,
+			build_int_cst (TREE_TYPE (c), IEEE_SIGNALING_NAN),
+			t3);
+  tree type = gfc_typenode_for_spec (&expr->ts);
+  /* Perform a quick sanity check that the return type is
+     IEEE_CLASS_TYPE derived type defined in
+     libgfortran/ieee/ieee_arithmetic.F90
+     Primarily check that it is a derived type with a single
+     member in it.  */
+  gcc_assert (TREE_CODE (type) == RECORD_TYPE);
+  tree field = NULL_TREE;
+  for (tree f = TYPE_FIELDS (type); f != NULL_TREE; f = DECL_CHAIN (f))
+    if (TREE_CODE (f) == FIELD_DECL)
+      {
+	gcc_assert (field == NULL_TREE);
+	field = f;
+      }
+  gcc_assert (field);
+  t1 = fold_convert (TREE_TYPE (field), t1);
+  se->expr = build_constructor_single (type, field, t1);
+  return true;
+}
+
+
 /* Generate code for an intrinsic function from the IEEE_ARITHMETIC
    module.  */
 
@@ -10038,6 +10130,8 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_LOGB);
   else if (startswith (name, "_gfortran_ieee_rint"))
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
+  else if (startswith (name, "ieee_class_") && ISDIGIT (name[11]))
+    return conv_intrinsic_ieee_class (se, expr);
   else
     /* It is not among the functions we translate directly.  We return
        false, so a library function call is emitted.  */
diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
index 7e310f2c5b0..0b87fbf7e9d 100644
--- a/libgfortran/ieee/ieee_helper.c
+++ b/libgfortran/ieee/ieee_helper.c
@@ -51,26 +51,6 @@ extern int ieee_class_helper_16 (GFC_REAL_16 *);
 internal_proto(ieee_class_helper_16);
 #endif
 
-/* Enumeration of the possible floating-point types. These values
-   correspond to the hidden arguments of the IEEE_CLASS_TYPE
-   derived-type of IEEE_ARITHMETIC.  */
-
-enum {
-  IEEE_OTHER_VALUE = 0,
-  IEEE_SIGNALING_NAN,
-  IEEE_QUIET_NAN,
-  IEEE_NEGATIVE_INF,
-  IEEE_NEGATIVE_NORMAL,
-  IEEE_NEGATIVE_DENORMAL,
-  IEEE_NEGATIVE_SUBNORMAL = IEEE_NEGATIVE_DENORMAL,
-  IEEE_NEGATIVE_ZERO,
-  IEEE_POSITIVE_ZERO,
-  IEEE_POSITIVE_DENORMAL,
-  IEEE_POSITIVE_SUBNORMAL = IEEE_POSITIVE_DENORMAL,
-  IEEE_POSITIVE_NORMAL,
-  IEEE_POSITIVE_INF
-};
-
 
 #define CLASSMACRO(TYPE) \
   int ieee_class_helper_ ## TYPE (GFC_REAL_ ## TYPE *value) \