[PATCH] fortran: Expand ieee_arithmetic module's ieee_value inline [PR106579]

[PATCH] fortran: Expand ieee_arithmetic module's ieee_value inline [PR106579]

[Jakub Jelinek]

Hi!

The following patch expands IEEE_VALUE function inline in the FE.

Bootstrapped/regtested on x86_64-linux, i686-linux, powerpc64le-linux
and powerpc64-linux, ok for trunk?

2022-08-15  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/106579
	* trans-intrinsic.cc: Include realmpfr.h.
	(conv_intrinsic_ieee_value): New function.
	(gfc_conv_ieee_arithmetic_function): Handle ieee_value.

--- gcc/fortran/trans-intrinsic.cc.jj	2022-08-12 18:51:28.095927643 +0200
+++ gcc/fortran/trans-intrinsic.cc	2022-08-13 13:24:37.446768877 +0200
@@ -41,6 +41,7 @@ along with GCC; see the file COPYING3.
 #include "trans-array.h"
 #include "dependency.h"	/* For CAF array alias analysis.  */
 #include "attribs.h"
+#include "realmpfr.h"
 
 /* Only for gfc_trans_assign and gfc_trans_pointer_assign.  */
 
@@ -10085,6 +10086,115 @@ conv_intrinsic_ieee_class (gfc_se *se, g
 }
 
 
+/* Generate code for IEEE_VALUE.  */
+
+static void
+conv_intrinsic_ieee_value (gfc_se *se, gfc_expr *expr)
+{
+  tree args[2], arg, ret, tmp;
+  stmtblock_t body;
+
+  /* Convert args, evaluate the second one only once.  */
+  conv_ieee_function_args (se, expr, args, 2);
+  arg = gfc_evaluate_now (args[1], &se->pre);
+
+  tree type = TREE_TYPE (arg);
+  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);
+  arg = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 arg, field, NULL_TREE);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gcc_assert (TREE_CODE (type) == REAL_TYPE);
+  ret = gfc_create_var (type, NULL);
+
+  gfc_init_block (&body);
+
+  tree end_label = gfc_build_label_decl (NULL_TREE);
+  for (int c = IEEE_SIGNALING_NAN; c <= IEEE_POSITIVE_INF; ++c)
+    {
+      tree label = gfc_build_label_decl (NULL_TREE);
+      tree low = build_int_cst (TREE_TYPE (arg), c);
+      tmp = build_case_label (low, low, label);
+      gfc_add_expr_to_block (&body, tmp);
+
+      REAL_VALUE_TYPE real;
+      int k;
+      switch (c)
+	{
+	case IEEE_SIGNALING_NAN:
+	  real_nan (&real, "", 0, TYPE_MODE (type));
+	  break;
+	case IEEE_QUIET_NAN:
+	  real_nan (&real, "", 1, TYPE_MODE (type));
+	  break;
+	case IEEE_NEGATIVE_INF:
+	  real_inf (&real);
+	  real = real_value_negate (&real);
+	  break;
+	case IEEE_NEGATIVE_NORMAL:
+	  real_from_integer (&real, TYPE_MODE (type), -42, SIGNED);
+	  break;
+	case IEEE_NEGATIVE_DENORMAL:
+	  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+	  real_from_mpfr (&real, gfc_real_kinds[k].tiny,
+			  type, GFC_RND_MODE);
+	  real_arithmetic (&real, RDIV_EXPR, &real, &dconst2);
+	  real = real_value_negate (&real);
+	  break;
+	case IEEE_NEGATIVE_ZERO:
+	  real_from_integer (&real, TYPE_MODE (type), 0, SIGNED);
+	  real = real_value_negate (&real);
+	  break;
+	case IEEE_POSITIVE_ZERO:
+	  /* Make this also the default: label.  */
+	  label = gfc_build_label_decl (NULL_TREE);
+	  tmp = build_case_label (NULL_TREE, NULL_TREE, label);
+	  gfc_add_expr_to_block (&body, tmp);
+	  real_from_integer (&real, TYPE_MODE (type), 0, SIGNED);
+	  break;
+	case IEEE_POSITIVE_DENORMAL:
+	  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+	  real_from_mpfr (&real, gfc_real_kinds[k].tiny,
+			  type, GFC_RND_MODE);
+	  real_arithmetic (&real, RDIV_EXPR, &real, &dconst2);
+	  break;
+	case IEEE_POSITIVE_NORMAL:
+	  real_from_integer (&real, TYPE_MODE (type), 42, SIGNED);
+	  break;
+	case IEEE_POSITIVE_INF:
+	  real_inf (&real);
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+
+      tree val = build_real (type, real);
+      gfc_add_modify (&body, ret, val);
+
+      tmp = build1_v (GOTO_EXPR, end_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  tmp = gfc_finish_block (&body);
+  tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE, arg, tmp);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  tmp = build1_v (LABEL_EXPR, end_label);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  se->expr = ret;
+}
+
+
 /* Generate code for an intrinsic function from the IEEE_ARITHMETIC
    module.  */
 
@@ -10117,6 +10227,8 @@ gfc_conv_ieee_arithmetic_function (gfc_s
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
   else if (startswith (name, "ieee_class_") && ISDIGIT (name[11]))
     conv_intrinsic_ieee_class (se, expr);
+  else if (startswith (name, "ieee_value_") && ISDIGIT (name[11]))
+    conv_intrinsic_ieee_value (se, expr);
   else
     /* It is not among the functions we translate directly.  We return
        false, so a library function call is emitted.  */

	Jakub

Re: [PATCH] fortran: Expand ieee_arithmetic module's ieee_value inline [PR106579]

[FX]

Hi Jakub,

I have two questions, on this and the ieee_class patch:


> +  tree type = TREE_TYPE (arg);
> +  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);

Why looping over fields? The class type is a simple type with only one member (and it should be an integer, we can assert that).


> +	case IEEE_POSITIVE_ZERO:
> +	  /* Make this also the default: label.  */
> +	  label = gfc_build_label_decl (NULL_TREE);
> +	  tmp = build_case_label (NULL_TREE, NULL_TREE, label);
> +	  gfc_add_expr_to_block (&body, tmp);
> +	  real_from_integer (&real, TYPE_MODE (type), 0, SIGNED);
> +	  break;

Do we need a default label? It’s not like this is a more likely case than anything else…


Thanks,
FX

Re: [PATCH] fortran: Expand ieee_arithmetic module's ieee_value inline [PR106579]

[Jakub Jelinek]

On Mon, Aug 15, 2022 at 10:00:02PM +0200, FX wrote:
> I have two questions, on this and the ieee_class patch:
> 
> 
> > +  tree type = TREE_TYPE (arg);
> > +  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);
> 
> Why looping over fields? The class type is a simple type with only one member (and it should be an integer, we can assert that).

I wanted to make sure it has exactly one field.
The ieee_arithmetic.F90 module in libgfortran surely does that, but I've
been worrying about some user overriding that module with something
different.  At least in the C/C++ FEs we had in the past tons of bugs filed
for when some builtin made some assumptions about some headers and data
types in those and then somebody running a testcase that violated that.
Even failed gcc_assertion isn't the best answer to that, ideally one would
verify that upfront and then either error, sorry or ignore the call (leave
it as is).  In that last case, it might be better to do the check on the
gfortran FE types instead of trees (verify the return type or second
argument type is ieee_class_type derived type with a single integral
(hidden) field).

> > +	case IEEE_POSITIVE_ZERO:
> > +	  /* Make this also the default: label.  */
> > +	  label = gfc_build_label_decl (NULL_TREE);
> > +	  tmp = build_case_label (NULL_TREE, NULL_TREE, label);
> > +	  gfc_add_expr_to_block (&body, tmp);
> > +	  real_from_integer (&real, TYPE_MODE (type), 0, SIGNED);
> > +	  break;
> 
> Do we need a default label? It’s not like this is a more likely case than anything else…

The libgfortran version had default: label:
    switch (type) \
    { \
      case IEEE_SIGNALING_NAN: \
        return __builtin_nans ## SUFFIX (""); \
      case IEEE_QUIET_NAN: \
        return __builtin_nan ## SUFFIX (""); \
      case IEEE_NEGATIVE_INF: \
        return - __builtin_inf ## SUFFIX (); \
      case IEEE_NEGATIVE_NORMAL: \
        return -42; \
      case IEEE_NEGATIVE_DENORMAL: \
        return -(GFC_REAL_ ## TYPE ## _TINY) / 2; \
      case IEEE_NEGATIVE_ZERO: \
        return -(GFC_REAL_ ## TYPE) 0; \
      case IEEE_POSITIVE_ZERO: \
        return 0; \
      case IEEE_POSITIVE_DENORMAL: \
        return (GFC_REAL_ ## TYPE ## _TINY) / 2; \
      case IEEE_POSITIVE_NORMAL: \
        return 42; \
      case IEEE_POSITIVE_INF: \
        return __builtin_inf ## SUFFIX (); \
      default: \
        return 0; \
    } \
and I've tried to traslate that into what it generates.
There is at least the IEEE_OTHER_VALUE (aka 0) value
that isn't covered in the switch, but it is just an integer
under the hood, so it could have any other value.

	Jakub

Re: [PATCH] fortran: Expand ieee_arithmetic module's ieee_value inline [PR106579]

[FX]

Hi,

>> Why looping over fields? The class type is a simple type with only one member (and it should be an integer, we can assert that).
> 
> I wanted to make sure it has exactly one field.
> The ieee_arithmetic.F90 module in libgfortran surely does that, but I've
> been worrying about some user overriding that module with something
> different.

In Fortran world it would be a rare and crazy thing to do, but I see. Could you add a comment (pointing out to the type definition in libgfortran)?


> The libgfortran version had default: label:
>    switch (type) \
>    { \
>      case IEEE_SIGNALING_NAN: \
>        return __builtin_nans ## SUFFIX (""); \
>      case IEEE_QUIET_NAN: \
>        return __builtin_nan ## SUFFIX (""); \
>      case IEEE_NEGATIVE_INF: \
>        return - __builtin_inf ## SUFFIX (); \
>      case IEEE_NEGATIVE_NORMAL: \
>        return -42; \
>      case IEEE_NEGATIVE_DENORMAL: \
>        return -(GFC_REAL_ ## TYPE ## _TINY) / 2; \
>      case IEEE_NEGATIVE_ZERO: \
>        return -(GFC_REAL_ ## TYPE) 0; \
>      case IEEE_POSITIVE_ZERO: \
>        return 0; \
>      case IEEE_POSITIVE_DENORMAL: \
>        return (GFC_REAL_ ## TYPE ## _TINY) / 2; \
>      case IEEE_POSITIVE_NORMAL: \
>        return 42; \
>      case IEEE_POSITIVE_INF: \
>        return __builtin_inf ## SUFFIX (); \
>      default: \
>        return 0; \
>    } \
> and I've tried to traslate that into what it generates.

OK, that makes sense. But:

> There is at least the IEEE_OTHER_VALUE (aka 0) value
> that isn't covered in the switch, but it is just an integer
> under the hood, so it could have any other value.

I think I originally included the default for IEEE_OTHER_VALUE, but the standard says IEEE_OTHER_VALUE as an argument to IEE_VALUE is not allowed. If removing the default would make the generated code shorter, I suggest we do it; otherwise let’s keep it.

With those two caveats, the patch is OK. We shouldn’t touch the library code for now, but when the patch is committed we can add the removal of IEEE_VALUE and IEEE_CLASS from the library to this list: https://gcc.gnu.org/wiki/LibgfortranAbiCleanup

FX