re PR fortran/15441 (RRSPACING broken for denormals)

2006-10-06  Steven G. Kargl  <kargl@gcc.gnu.org>
 
	* gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
	* arith.c (arctangent, gfc_check_real_range): Use it.	
	* simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
	gfc_simplify_log, gfc_simplify_nearest): Use it.

	PR fortran/15441
	PR fortran/29312
	* iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
	routine hidden precision argument.
	(gfc_resolve_spacing): Give spacing library routine hidden
	precision, emin - 1, and tiny(x) arguments.
	* simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
	(gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
	(gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
	* trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
	spacing via LIBF_FUNCTION
	(prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
	gfc_conv_intrinsic_rrspacing): Remove functions.
	(gfc_conv_intrinsic_function): Remove calls to
	gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
	* f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
	__builtin_clzl and __builtin_clzll


2006-10-06  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/15441
	PR fortran/29312
	* configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL
	* m4/spacing.m4: New file.  Use new HAVE_* defines.
	* m4/rrspacing.m4: Ditto.
	* Makefile.am: Handle new files.
	* configure: Regenerated.
	* Makefile.in: Ditto.
	* config.h.in: Ditto.
	* generated/spacing_r4.c: Generated.
	* generated/spacing_r8.c: Ditto.
	* generated/spacing_r10.c: Ditto.
	* generated/spacing_r16.c: Ditto.
	* generated/rrspacing_r4.c: Ditto.
	* generated/rrspacing_r8.c: Ditto.
	* generated/rrspacing_r10.c: Ditto.
	* generated/rrspacing_r16.c: Ditto.

From-SVN: r117584

7 files changed, 159 insertions, 252 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 85c9533ffcf..16672af41d3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+2006-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
+	* arith.c (arctangent, gfc_check_real_range): Use it.	
+	* simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
+	gfc_simplify_log, gfc_simplify_nearest): Use it.
+
+	PR fortran/15441
+	PR fortran/29312
+	* iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
+	routine hidden precision argument.
+	(gfc_resolve_spacing): Give spacing library routine hidden
+	precision, emin - 1, and tiny(x) arguments.
+	* simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
+	(gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
+	(gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
+	* trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
+	spacing via LIBF_FUNCTION
+	(prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
+	gfc_conv_intrinsic_rrspacing): Remove functions.
+	(gfc_conv_intrinsic_function): Remove calls to
+	gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
+	* f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
+	__builtin_clzl and __builtin_clzll
+
 2006-10-09  Richard Henderson  <rth@redhat.com>
 
 	Revert emutls patch.
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 3541adc49a6..d4c527fb356 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -75,7 +75,7 @@ gfc_set_model (mpfr_t x)
   mpfr_set_default_prec (mpfr_get_prec (x));
 }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
 /* Calculate atan2 (y, x)
 
 atan2(y, x) = atan(y/x)				if x > 0,
@@ -412,7 +412,7 @@ gfc_check_real_range (mpfr_t p, int kind)
     }
   else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
     {
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
       /* MPFR operates on a number with a given precision and enormous
 	exponential range.  To represent subnormal numbers, the exponent is
 	allowed to become smaller than emin, but always retains the full
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 6dc00da63a3..fb626f70446 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -937,21 +937,6 @@ gfc_init_builtin_functions (void)
 
   /* Other builtin functions we use.  */
 
-  tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
-		      "__builtin_clz", true);
-
-  tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
-		      "__builtin_clzl", true);
-
-  tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
-		      "__builtin_clzll", true);
-
   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
   tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
   ftype = build_function_type (long_integer_type_node, tmp);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5ba7ad4fc84..7b624b07711 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1224,6 +1224,10 @@ gfc_intrinsic_sym;
 #include <gmp.h>
 #include <mpfr.h>
 #define GFC_RND_MODE GMP_RNDN
+#undef GFC_MPFR_TOO_OLD
+#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#define GFC_MPFR_TOO_OLD 1
+#endif
 
 typedef struct gfc_expr
 {
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 1e57881125c..c702294fc82 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1754,8 +1754,19 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 void
 gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 {
+  int k;
+  gfc_actual_arglist *prec;
+
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
+
+  /* Create a hidden argument to the library routines for rrspacing.  This
+     hidden argument is the precision of x.  */
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  prec = gfc_get_actual_arglist ();
+  prec->name = "p";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  f->value.function.actual->next = prec;
 }
 
 
@@ -1885,8 +1896,40 @@ gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
 {
+  int k; 
+  gfc_actual_arglist *prec, *tiny, *emin_1;
+ 
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
+
+  /* Create hidden arguments to the library routine for spacing.  These
+     hidden arguments are tiny(x), min_exponent - 1,  and the precision
+     of x.  */
+
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+  tiny = gfc_get_actual_arglist ();
+  tiny->name = "tiny";
+  tiny->expr = gfc_get_expr ();
+  tiny->expr->expr_type = EXPR_CONSTANT;
+  tiny->expr->where = gfc_current_locus;
+  tiny->expr->ts.type = x->ts.type;
+  tiny->expr->ts.kind = x->ts.kind;
+  mpfr_init (tiny->expr->value.real);
+  mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+
+  emin_1 = gfc_get_actual_arglist ();
+  emin_1->name = "emin";
+  emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
+  emin_1->next = tiny;
+
+  prec = gfc_get_actual_arglist ();
+  prec->name = "prec";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  prec->next = emin_1;
+
+  f->value.function.actual->next = prec;
+
 }
 
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 9d35bae749e..1b04e6e4a91 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -607,7 +607,7 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x)
       return &gfc_bad_expr;
     }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   arctangent2 (y->value.real, x->value.real, result->value.real);
 #else
   mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
@@ -1060,7 +1060,7 @@ gfc_simplify_exponent (gfc_expr * x)
   int i;
   gfc_expr *result;
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   mpfr_t tmp;
 #endif
 
@@ -1078,7 +1078,7 @@ gfc_simplify_exponent (gfc_expr * x)
       return result;
     }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   /* PR fortran/28276 suffers from a buggy MPFR, and this block of code
      does not function correctly.  */
   mpfr_init (tmp);
@@ -1096,7 +1096,6 @@ gfc_simplify_exponent (gfc_expr * x)
 
   mpfr_clear (tmp);
 #else
-  /* Requires MPFR 2.2.0 or newer.  */
   i = (int) mpfr_get_exp (x->value.real);
   mpz_set_si (result->value.integer, i);
 #endif
@@ -2161,7 +2160,7 @@ gfc_simplify_log (gfc_expr * x)
       mpfr_init (xr);
       mpfr_init (xi);
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
       arctangent2 (x->value.complex.i, x->value.complex.r, result->value.complex.i);
 #else
       mpfr_atan2 (result->value.complex.i, x->value.complex.i, x->value.complex.r,
@@ -2495,10 +2494,8 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
   gfc_expr *result;
   mpfr_t tmp;
   int sgn;
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   int direction;
-#else
-  mp_exp_t emin, emax;
 #endif
 
   if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
@@ -2513,7 +2510,7 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
   gfc_set_model_kind (x->ts.kind);
   result = gfc_copy_expr (x);
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
 
   direction = mpfr_sgn (s->value.real);
   sgn = mpfr_sgn (x->value.real);
@@ -2561,25 +2558,10 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
 	mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
     }
 #else
-
-  /* Save current values of emin and emax.  */
-  emin = mpfr_get_emin ();
-  emax = mpfr_get_emax ();
-
-  /* Set emin and emax for the current model number.  */
-  sgn = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
-  mpfr_set_emin ((mp_exp_t) gfc_real_kinds[sgn].min_exponent - 1);
-  mpfr_set_emax ((mp_exp_t) gfc_real_kinds[sgn].max_exponent - 1);
-
   sgn = mpfr_sgn (s->value.real); 
   mpfr_init (tmp);
   mpfr_set_inf (tmp, sgn);
   mpfr_nexttoward (result->value.real, tmp);
-  mpfr_subnormalize (result->value.real, 0, GFC_RND_MODE);
- 
-  mpfr_set_emin (emin);
-  mpfr_set_emax (emax);
- 
   mpfr_clear(tmp);
 #endif
 
@@ -3130,6 +3112,7 @@ bad_reshape:
 }
 
 
+#if defined(GFC_MPFR_TOO_OLD)
 gfc_expr *
 gfc_simplify_rrspacing (gfc_expr * x)
 {
@@ -3150,7 +3133,7 @@ gfc_simplify_rrspacing (gfc_expr * x)
 
   if (mpfr_sgn (x->value.real) == 0)
     {
-      mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
       return result;
     }
 
@@ -3179,7 +3162,40 @@ gfc_simplify_rrspacing (gfc_expr * x)
 
   return range_check (result, "RRSPACING");
 }
+#else
+gfc_expr *
+gfc_simplify_rrspacing (gfc_expr * x)
+{
+  gfc_expr *result;
+  int i;
+  long int e, p;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
 
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
+
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+
+  /* Special case x = 0 and 0.  */
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  /* | x * 2**(-e) | * 2**p.  */
+  e = - (long int) mpfr_get_exp (x->value.real);
+  mpfr_mul_2si (result->value.real, result->value.real, e, GFC_RND_MODE);
+
+  p = (long int) gfc_real_kinds[i].digits;
+  mpfr_mul_2si (result->value.real, result->value.real, p, GFC_RND_MODE);
+
+  return range_check (result, "RRSPACING");
+}
+#endif
 
 gfc_expr *
 gfc_simplify_scale (gfc_expr * x, gfc_expr * i)
@@ -3623,7 +3639,7 @@ gfc_simplify_sngl (gfc_expr * a)
   return range_check (result, "SNGL");
 }
 
-
+#if defined(GFC_MPFR_TOO_OLD)
 gfc_expr *
 gfc_simplify_spacing (gfc_expr * x)
 {
@@ -3643,16 +3659,16 @@ gfc_simplify_spacing (gfc_expr * x)
 
   gfc_set_model_kind (x->ts.kind);
 
-  if (mpfr_sgn (x->value.real) == 0)
+  /* Special case x = 0 and -0.  */
+  mpfr_init (absv);
+  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
+  if (mpfr_sgn (absv) == 0)
     {
       mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
       return result;
     }
 
   mpfr_init (log2);
-  mpfr_init (absv);
-
-  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
   mpfr_log2 (log2, absv, GFC_RND_MODE);
   mpfr_trunc (log2, log2);
 
@@ -3674,7 +3690,44 @@ gfc_simplify_spacing (gfc_expr * x)
 
   return range_check (result, "SPACING");
 }
+#else
+gfc_expr *
+gfc_simplify_spacing (gfc_expr * x)
+{
+  gfc_expr *result;
+  int i;
+  long int en, ep;
 
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
+
+  /* Special case x = 0 and -0.  */
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+      return result;
+    }
+
+  /* In the Fortran 95 standard, the result is b**(e - p) where b, e, and p
+     are the radix, exponent of x, and precision.  This excludes the 
+     possibility of subnormal numbers.  Fortran 2003 states the result is
+     b**max(e - p, emin - 1).  */
+
+  ep = (long int) mpfr_get_exp (x->value.real) - gfc_real_kinds[i].digits;
+  en = (long int) gfc_real_kinds[i].min_exponent - 1;
+  en = en > ep ? en : ep;
+
+  mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
+  mpfr_mul_2si (result->value.real, result->value.real, en, GFC_RND_MODE);
+
+  return range_check (result, "SPACING");
+}
+#endif
 
 gfc_expr *
 gfc_simplify_sqrt (gfc_expr * e)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index facc15a739a..811555d37ca 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -129,7 +129,9 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
   /* Functions in libgfortran.  */
   LIBF_FUNCTION (FRACTION, "fraction", false),
   LIBF_FUNCTION (NEAREST, "nearest", false),
+  LIBF_FUNCTION (RRSPACING, "rrspacing", false),
   LIBF_FUNCTION (SET_EXPONENT, "set_exponent", false),
+  LIBF_FUNCTION (SPACING, "spacing", false),
 
   /* End the list.  */
   LIBF_FUNCTION (NONE, NULL, false)
@@ -3003,203 +3005,6 @@ gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr)
   se->expr = convert (type, se->expr);
 }
 
-/* Prepare components and related information of a real number which is
-   the first argument of a elemental functions to manipulate reals.  */
-
-static void
-prepare_arg_info (gfc_se * se, gfc_expr * expr,
-		  real_compnt_info * rcs, int all)
-{
-   tree arg;
-   tree masktype;
-   tree tmp;
-   tree wbits;
-   tree one;
-   tree exponent, fraction;
-   int n;
-   gfc_expr *a1;
-
-   if (TARGET_FLOAT_FORMAT != IEEE_FLOAT_FORMAT)
-     gfc_todo_error ("Non-IEEE floating format");
-
-   gcc_assert (expr->expr_type == EXPR_FUNCTION);
-
-   arg = gfc_conv_intrinsic_function_args (se, expr);
-   arg = TREE_VALUE (arg);
-   rcs->type = TREE_TYPE (arg);
-
-   /* Force arg'type to integer by unaffected convert  */
-   a1 = expr->value.function.actual->expr;
-   masktype = gfc_get_int_type (a1->ts.kind);
-   rcs->mtype = masktype;
-   tmp = build1 (VIEW_CONVERT_EXPR, masktype, arg);
-   arg = gfc_create_var (masktype, "arg");
-   gfc_add_modify_expr(&se->pre, arg, tmp);
-   rcs->arg = arg;
-
-   /* Calculate the numbers of bits of exponent, fraction and word  */
-   n = gfc_validate_kind (a1->ts.type, a1->ts.kind, false);
-   tmp = build_int_cst (NULL_TREE, gfc_real_kinds[n].digits - 1);
-   rcs->fdigits = convert (masktype, tmp);
-   wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1);
-   wbits = convert (masktype, wbits);
-   rcs->edigits = fold_build2 (MINUS_EXPR, masktype, wbits, tmp);
-
-   /* Form masks for exponent/fraction/sign  */
-   one = gfc_build_const (masktype, integer_one_node);
-   rcs->smask = fold_build2 (LSHIFT_EXPR, masktype, one, wbits);
-   rcs->f1 = fold_build2 (LSHIFT_EXPR, masktype, one, rcs->fdigits);
-   rcs->emask = fold_build2 (MINUS_EXPR, masktype, rcs->smask, rcs->f1);
-   rcs->fmask = fold_build2 (MINUS_EXPR, masktype, rcs->f1, one);
-   /* Form bias.  */
-   tmp = fold_build2 (MINUS_EXPR, masktype, rcs->edigits, one);
-   tmp = fold_build2 (LSHIFT_EXPR, masktype, one, tmp);
-   rcs->bias = fold_build2 (MINUS_EXPR, masktype, tmp ,one);
-
-   if (all)
-     {
-       /* exponent, and fraction  */
-       tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->emask);
-       tmp = build2 (RSHIFT_EXPR, masktype, tmp, rcs->fdigits);
-       exponent = gfc_create_var (masktype, "exponent");
-       gfc_add_modify_expr(&se->pre, exponent, tmp);
-       rcs->expn = exponent;
-
-       tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->fmask);
-       fraction = gfc_create_var (masktype, "fraction");
-       gfc_add_modify_expr(&se->pre, fraction, tmp);
-       rcs->frac = fraction;
-     }
-}
-
-/* Build a call to __builtin_clz.  */
-
-static tree
-call_builtin_clz (tree result_type, tree op0)
-{
-  tree fn, parms, call;
-  enum machine_mode op0_mode = TYPE_MODE (TREE_TYPE (op0));
-
-  if (op0_mode == TYPE_MODE (integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZ];
-  else if (op0_mode == TYPE_MODE (long_integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZL];
-  else if (op0_mode == TYPE_MODE (long_long_integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZLL];
-  else
-    gcc_unreachable ();
-
-  parms = tree_cons (NULL, op0, NULL);
-  call = build_function_call_expr (fn, parms);
-
-  return convert (result_type, call);
-}
-
-
-/* Generate code for SPACING (X) intrinsic function.
-   SPACING (X) = POW (2, e-p)
-
-   We generate:
-
-    t = expn - fdigits // e - p.
-    res = t << fdigits // Form the exponent. Fraction is zero.
-    if (t < 0) // The result is out of range. Denormalized case.
-      res = tiny(X)
- */
-
-static void
-gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
-{
-   tree arg;
-   tree masktype;
-   tree tmp, t1, cond;
-   tree tiny, zero;
-   tree fdigits;
-   real_compnt_info rcs;
-
-   prepare_arg_info (se, expr, &rcs, 0);
-   arg = rcs.arg;
-   masktype = rcs.mtype;
-   fdigits = rcs.fdigits;
-   tiny = rcs.f1;
-   zero = gfc_build_const (masktype, integer_zero_node);
-   tmp = build2 (BIT_AND_EXPR, masktype, rcs.emask, arg);
-   tmp = build2 (RSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build2 (MINUS_EXPR, masktype, tmp, fdigits);
-   cond = build2 (LE_EXPR, boolean_type_node, tmp, zero);
-   t1 = build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build3 (COND_EXPR, masktype, cond, tiny, t1);
-   tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
-
-   se->expr = tmp;
-}
-
-/* Generate code for RRSPACING (X) intrinsic function.
-   RRSPACING (X) = |X * POW (2, -e)| * POW (2, p) = |FRACTION (X)| * POW (2, p)
-
-   So the result's exponent is p. And if X is normalized, X's fraction part
-   is the result's fraction. If X is denormalized, to get the X's fraction we
-   shift X's fraction part to left until the first '1' is removed.
-
-   We generate:
-
-    if (expn == 0 && frac == 0)
-       res = 0;
-    else
-    {
-       // edigits is the number of exponent bits. Add the sign bit.
-       sedigits = edigits + 1;
-
-       if (expn == 0) // Denormalized case.
-       {
-         t1 = leadzero (frac);
-         frac = frac << (t1 + 1); //Remove the first '1'.
-         frac = frac >> (sedigits); //Form the fraction.
-       }
-
-       //fdigits is the number of fraction bits. Form the exponent.
-       t = bias + fdigits;
-
-       res = (t << fdigits) | frac;
-    }
-*/
-
-static void
-gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
-{
-   tree masktype;
-   tree tmp, t1, t2, cond, cond2;
-   tree one, zero;
-   tree fdigits, fraction;
-   real_compnt_info rcs;
-
-   prepare_arg_info (se, expr, &rcs, 1);
-   masktype = rcs.mtype;
-   fdigits = rcs.fdigits;
-   fraction = rcs.frac;
-   one = gfc_build_const (masktype, integer_one_node);
-   zero = gfc_build_const (masktype, integer_zero_node);
-   t2 = fold_build2 (PLUS_EXPR, masktype, rcs.edigits, one);
-
-   t1 = call_builtin_clz (masktype, fraction);
-   tmp = build2 (PLUS_EXPR, masktype, t1, one);
-   tmp = build2 (LSHIFT_EXPR, masktype, fraction, tmp);
-   tmp = build2 (RSHIFT_EXPR, masktype, tmp, t2);
-   cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero);
-   fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction);
-
-   tmp = fold_build2 (PLUS_EXPR, masktype, rcs.bias, fdigits);
-   tmp = fold_build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction);
-
-   cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero);
-   cond = build2 (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
-   tmp = build3 (COND_EXPR, masktype, cond,
-		 build_int_cst (masktype, 0), tmp);
-
-   tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
-   se->expr = tmp;
-}
 
 /* Generate code for SELECTED_INT_KIND (R) intrinsic function.  */
 
@@ -3420,14 +3225,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_exponent (se, expr);
       break;
 
-    case GFC_ISYM_SPACING:
-      gfc_conv_intrinsic_spacing (se, expr);
-      break;
-
-    case GFC_ISYM_RRSPACING:
-      gfc_conv_intrinsic_rrspacing (se, expr);
-      break;
-
     case GFC_ISYM_SCAN:
       gfc_conv_intrinsic_scan (se, expr);
       break;