PR fortran/33387

	* trans.h: Remove prototypes for gfor_fndecl_math_exponent4,
	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
	gfor_fndecl_math_exponent16.
	* f95-lang.c (build_builtin_fntypes): Add new function types.
	(gfc_init_builtin_functions): Add new builtins for nextafter,
	frexp, ldexp, fabs, scalbn and inf.
	* iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments.
	(gfc_resolve_scale): Don't convert type of second argument.
	(gfc_resolve_set_exponent): Likewise.
	(gfc_resolve_size): Don't add hidden arguments.
	* trans-decl.c: Remove gfor_fndecl_math_exponent4,
	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
	gfor_fndecl_math_exponent16.
	* trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics
	for scalbn, fraction, nearest, rrspacing, set_exponent and
	spacing.
	(gfc_conv_intrinsic_exponent): Directly call frexp.
	(gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest,
	gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
	gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New
	functions.
	(gfc_conv_intrinsic_function): Use the new functions above.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@132713 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 431 insertions, 177 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad701386190..0b69dd5927a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,29 @@
+2008-02-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33387
+	* trans.h: Remove prototypes for gfor_fndecl_math_exponent4,
+	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
+	gfor_fndecl_math_exponent16.
+	* f95-lang.c (build_builtin_fntypes): Add new function types.
+	(gfc_init_builtin_functions): Add new builtins for nextafter,
+	frexp, ldexp, fabs, scalbn and inf.
+	* iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments.
+	(gfc_resolve_scale): Don't convert type of second argument.
+	(gfc_resolve_set_exponent): Likewise.
+	(gfc_resolve_size): Don't add hidden arguments.
+	* trans-decl.c: Remove gfor_fndecl_math_exponent4,
+	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
+	gfor_fndecl_math_exponent16.
+	* trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics
+	for scalbn, fraction, nearest, rrspacing, set_exponent and
+	spacing.
+	(gfc_conv_intrinsic_exponent): Directly call frexp.
+	(gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest,
+	gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
+	gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New
+	functions.
+	(gfc_conv_intrinsic_function): Use the new functions above.
+
 2008-02-26  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/35033
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 643f41865e4..7a3e413caf3 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -756,6 +756,16 @@ build_builtin_fntypes (tree *fntype, tree type)
   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
   tmp = tree_cons (NULL_TREE, type, tmp);
   fntype[2] = build_function_type (type, tmp);
+  /* type (*) (void) */
+  fntype[3] = build_function_type (type, void_list_node);
+  /* type (*) (type, &int) */
+  tmp = tree_cons (NULL_TREE, type, void_list_node);
+  tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
+  fntype[4] = build_function_type (type, tmp);
+  /* type (*) (type, int) */
+  tmp = tree_cons (NULL_TREE, type, void_list_node);
+  tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
+  fntype[5] = build_function_type (type, tmp);
 }
 
 
@@ -806,12 +816,12 @@ gfc_init_builtin_functions (void)
     ATTR_CONST_NOTHROW_LIST
   };
 
-  tree mfunc_float[3];
-  tree mfunc_double[3];
-  tree mfunc_longdouble[3];
-  tree mfunc_cfloat[3];
-  tree mfunc_cdouble[3];
-  tree mfunc_clongdouble[3];
+  tree mfunc_float[6];
+  tree mfunc_double[6];
+  tree mfunc_longdouble[6];
+  tree mfunc_cfloat[6];
+  tree mfunc_cdouble[6];
+  tree mfunc_clongdouble[6];
   tree func_cfloat_float, func_float_cfloat;
   tree func_cdouble_double, func_double_cdouble;
   tree func_clongdouble_longdouble, func_longdouble_clongdouble;
@@ -902,6 +912,34 @@ gfc_init_builtin_functions (void)
   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], 
 		      BUILT_IN_COPYSIGNF, "copysignf", true);
  
+  gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1], 
+		      BUILT_IN_NEXTAFTERL, "nextafterl", true);
+  gfc_define_builtin ("__builtin_nextafter", mfunc_double[1], 
+		      BUILT_IN_NEXTAFTER, "nextafter", true);
+  gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1], 
+		      BUILT_IN_NEXTAFTERF, "nextafterf", true);
+ 
+  gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], 
+		      BUILT_IN_FREXPL, "frexpl", false);
+  gfc_define_builtin ("__builtin_frexp", mfunc_double[4], 
+		      BUILT_IN_FREXP, "frexp", false);
+  gfc_define_builtin ("__builtin_frexpf", mfunc_float[4], 
+		      BUILT_IN_FREXPF, "frexpf", false);
+ 
+  gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0], 
+		      BUILT_IN_FABSL, "fabsl", true);
+  gfc_define_builtin ("__builtin_fabs", mfunc_double[0], 
+		      BUILT_IN_FABS, "fabs", true);
+  gfc_define_builtin ("__builtin_fabsf", mfunc_float[0], 
+		      BUILT_IN_FABSF, "fabsf", true);
+ 
+  gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5], 
+		      BUILT_IN_SCALBNL, "scalbnl", true);
+  gfc_define_builtin ("__builtin_scalbn", mfunc_double[5], 
+		      BUILT_IN_SCALBN, "scalbn", true);
+  gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5], 
+		      BUILT_IN_SCALBNF, "scalbnf", true);
+ 
   gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], 
 		      BUILT_IN_FMODL, "fmodl", true);
   gfc_define_builtin ("__builtin_fmod", mfunc_double[1], 
@@ -909,6 +947,13 @@ gfc_init_builtin_functions (void)
   gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], 
 		      BUILT_IN_FMODF, "fmodf", true);
 
+  gfc_define_builtin ("__builtin_infl", mfunc_longdouble[3], 
+		      BUILT_IN_INFL, "__builtin_infl", true);
+  gfc_define_builtin ("__builtin_inf", mfunc_double[3], 
+		      BUILT_IN_INF, "__builtin_inf", true);
+  gfc_define_builtin ("__builtin_inff", mfunc_float[3], 
+		      BUILT_IN_INFF, "__builtin_inff", true);
+
   /* lround{f,,l} and llround{f,,l} */
   type = tree_cons (NULL_TREE, float_type_node, void_list_node);
   tmp = build_function_type (long_integer_type_node, type); 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 3bc07fe633b..27a0022261f 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1853,47 +1853,15 @@ 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);
-  /* The library routine expects INTEGER(4).  */
-  if (prec->expr->ts.kind != gfc_c_int_kind)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_INTEGER;
-      ts.kind = gfc_c_int_kind;
-      gfc_convert_type (prec->expr, &ts, 2);
-    }
-  f->value.function.actual->next = prec;
 }
 
 
 void
-gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i)
+gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i ATTRIBUTE_UNUSED)
 {
   f->ts = x->ts;
-
-  /* The implementation calls scalbn which takes an int as the
-     second argument.  */
-  if (i->ts.kind != gfc_c_int_kind)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_INTEGER;
-      ts.kind = gfc_c_int_kind;
-      gfc_convert_type_warn (i, &ts, 2, 0);
-    }
-
   f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind);
 }
 
@@ -1921,22 +1889,10 @@ gfc_resolve_secnds (gfc_expr *t1, gfc_expr *t0)
 
 
 void
-gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, gfc_expr *i)
+gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x,
+			  gfc_expr *i ATTRIBUTE_UNUSED)
 {
   f->ts = x->ts;
-
-  /* The library implementation uses GFC_INTEGER_4 unconditionally,
-     convert type so we don't have to implement all possible
-     permutations.  */
-  if (i->ts.kind != gfc_c_int_kind)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_INTEGER;
-      ts.kind = gfc_c_int_kind;
-      gfc_convert_type_warn (i, &ts, 2, 0);
-    }
-
   f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind);
 }
 
@@ -2016,59 +1972,8 @@ gfc_resolve_size (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
 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);
-
-  /* The library routine expects INTEGER(4).  */
-  if (emin_1->expr->ts.kind != gfc_c_int_kind)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_INTEGER;
-      ts.kind = gfc_c_int_kind;
-      gfc_convert_type (emin_1->expr, &ts, 2);
-    }
-  emin_1->next = tiny;
-
-  prec = gfc_get_actual_arglist ();
-  prec->name = "prec";
-  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
-
-  /* The library routine expects INTEGER(4).  */
-  if (prec->expr->ts.kind != gfc_c_int_kind)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_INTEGER;
-      ts.kind = gfc_c_int_kind;
-      gfc_convert_type (prec->expr, &ts, 2);
-    }
-  prec->next = emin_1;
-
-  f->value.function.actual->next = prec;
 }
 
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 70609aca135..bf07a88f238 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -102,10 +102,6 @@ gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 tree gfor_fndecl_math_ishftc4;
 tree gfor_fndecl_math_ishftc8;
 tree gfor_fndecl_math_ishftc16;
-tree gfor_fndecl_math_exponent4;
-tree gfor_fndecl_math_exponent8;
-tree gfor_fndecl_math_exponent10;
-tree gfor_fndecl_math_exponent16;
 
 
 /* String functions.  */
@@ -2010,10 +2006,6 @@ gfc_build_intrinsic_function_decls (void)
   tree gfc_int8_type_node = gfc_get_int_type (8);
   tree gfc_int16_type_node = gfc_get_int_type (16);
   tree gfc_logical4_type_node = gfc_get_logical_type (4);
-  tree gfc_real4_type_node = gfc_get_real_type (4);
-  tree gfc_real8_type_node = gfc_get_real_type (8);
-  tree gfc_real10_type_node = gfc_get_real_type (10);
-  tree gfc_real16_type_node = gfc_get_real_type (16);
 
   /* String functions.  */
   gfor_fndecl_compare_string =
@@ -2199,25 +2191,6 @@ gfc_build_intrinsic_function_decls (void)
 				       gfc_int4_type_node,
 				       gfc_int4_type_node);
 
-  gfor_fndecl_math_exponent4 =
-    gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")),
-				     gfc_int4_type_node,
-				     1, gfc_real4_type_node);
-  gfor_fndecl_math_exponent8 =
-    gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")),
-				     gfc_int4_type_node,
-				     1, gfc_real8_type_node);
-  if (gfc_real10_type_node)
-    gfor_fndecl_math_exponent10 =
-      gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")),
-				       gfc_int4_type_node, 1,
-				       gfc_real10_type_node);
-  if (gfc_real16_type_node)
-    gfor_fndecl_math_exponent16 =
-      gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")),
-				       gfc_int4_type_node, 1,
-				       gfc_real16_type_node);
-
   /* BLAS functions.  */
   {
     tree pint = build_pointer_type (integer_type_node);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 6591b97a316..77bad73d51d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -104,43 +104,19 @@ gfc_intrinsic_map_t;
     true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
     NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
 
-#define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
-    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
-
-#define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
-    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
-
 static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
 {
   /* Functions built into gcc itself.  */
 #include "mathbuiltins.def"
 
-  /* Functions in libm.  */
-  /* ??? This does exist as BUILT_IN_SCALBN, but doesn't quite fit the
-     pattern for other mathbuiltins.def entries.  At present we have no
-     optimizations for this in the common sources.  */
-  LIBM_FUNCTION (SCALE, "scalbn", false),
-
-  /* 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)
+  { GFC_ISYM_NONE, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS,
+    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS,
+    true, false, true, NULL, NULL_TREE, NULL_TREE, NULL_TREE,
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
 };
 #undef DEFINE_MATH_BUILTIN
 #undef DEFINE_MATH_BUILTIN_C
-#undef LIBM_FUNCTION
-#undef LIBF_FUNCTION
 
 /* Structure for storing components of a floating number to be used by
    elemental functions to manipulate reals.  */
@@ -727,38 +703,43 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
   se->expr = build_call_array (rettype, fndecl, num_args, args);
 }
 
-/* Generate code for EXPONENT(X) intrinsic function.  */
+/* The EXPONENT(s) intrinsic function is translated into
+       int ret;
+       frexp (s, &ret);
+       return ret;
+ */
 
 static void
 gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
 {
-  tree arg, fndecl, type;
-  gfc_expr *a1;
-
-  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  tree arg, type, res, tmp;
+  int frexp;
 
-  a1 = expr->value.function.actual->expr;
-  switch (a1->ts.kind)
+  switch (expr->value.function.actual->expr->ts.kind)
     {
     case 4:
-      fndecl = gfor_fndecl_math_exponent4;
+      frexp = BUILT_IN_FREXPF;
       break;
     case 8:
-      fndecl = gfor_fndecl_math_exponent8;
+      frexp = BUILT_IN_FREXP;
       break;
     case 10:
-      fndecl = gfor_fndecl_math_exponent10;
-      break;
     case 16:
-      fndecl = gfor_fndecl_math_exponent16;
+      frexp = BUILT_IN_FREXPL;
       break;
     default:
       gcc_unreachable ();
     }
 
-  /* Convert it to the required type.  */
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  res = gfc_create_var (integer_type_node, NULL);
+  tmp = build_call_expr (built_in_decls[frexp], 2, arg,
+			 build_fold_addr_expr (res));
+  gfc_add_expr_to_block (&se->pre, tmp);
+
   type = gfc_typenode_for_spec (&expr->ts);
-  se->expr = fold_convert (type, build_call_expr (fndecl, 1, arg));
+  se->expr = fold_convert (type, res);
 }
 
 /* Evaluate a single upper or lower bound.  */
@@ -2823,6 +2804,310 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* FRACTION (s) is translated into frexp (s, &dummy_int).  */
+static void
+gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, tmp;
+  int frexp;
+
+  switch (expr->ts.kind)
+    {
+      case 4:
+	frexp = BUILT_IN_FREXPF;
+	break;
+      case 8:
+	frexp = BUILT_IN_FREXP;
+	break;
+      case 10:
+      case 16:
+	frexp = BUILT_IN_FREXPL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  tmp = gfc_create_var (integer_type_node, NULL);
+  se->expr = build_call_expr (built_in_decls[frexp], 2,
+			      fold_convert (type, arg),
+			      build_fold_addr_expr (tmp));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* NEAREST (s, dir) is translated into
+     tmp = copysign (INF, dir);
+     return nextafter (s, tmp);
+ */
+static void
+gfc_conv_intrinsic_nearest (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, tmp;
+  int nextafter, copysign, inf;
+
+  switch (expr->ts.kind)
+    {
+      case 4:
+	nextafter = BUILT_IN_NEXTAFTERF;
+	copysign = BUILT_IN_COPYSIGNF;
+	inf = BUILT_IN_INFF;
+	break;
+      case 8:
+	nextafter = BUILT_IN_NEXTAFTER;
+	copysign = BUILT_IN_COPYSIGN;
+	inf = BUILT_IN_INF;
+	break;
+      case 10:
+      case 16:
+	nextafter = BUILT_IN_NEXTAFTERL;
+	copysign = BUILT_IN_COPYSIGNL;
+	inf = BUILT_IN_INFL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  tmp = build_call_expr (built_in_decls[copysign], 2,
+			 build_call_expr (built_in_decls[inf], 0),
+			 fold_convert (type, args[1]));
+  se->expr = build_call_expr (built_in_decls[nextafter], 2,
+			      fold_convert (type, args[0]), tmp);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* SPACING (s) is translated into
+    int e;
+    if (s == 0)
+      res = tiny;
+    else
+    {
+      frexp (s, &e);
+      e = e - prec;
+      e = MAX_EXPR (e, emin);
+      res = scalbn (1., e);
+    }
+    return res;
+
+ where prec is the precision of s, gfc_real_kinds[k].digits,
+       emin is min_exponent - 1, gfc_real_kinds[k].min_exponent - 1,
+   and tiny is tiny(s), gfc_real_kinds[k].tiny.  */
+
+static void
+gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, prec, emin, tiny, res, e;
+  tree cond, tmp;
+  int frexp, scalbn, k;
+  stmtblock_t block;
+
+  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+  prec = build_int_cst (NULL_TREE, gfc_real_kinds[k].digits);
+  emin = build_int_cst (NULL_TREE, gfc_real_kinds[k].min_exponent - 1);
+  tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind);
+
+  switch (expr->ts.kind)
+    {
+      case 4:
+	frexp = BUILT_IN_FREXPF;
+	scalbn = BUILT_IN_SCALBNF;
+	break;
+      case 8:
+	frexp = BUILT_IN_FREXP;
+	scalbn = BUILT_IN_SCALBN;
+	break;
+      case 10:
+      case 16:
+	frexp = BUILT_IN_FREXPL;
+	scalbn = BUILT_IN_SCALBNL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  e = gfc_create_var (integer_type_node, NULL);
+  res = gfc_create_var (type, NULL);
+
+
+  /* Build the block for s /= 0.  */
+  gfc_start_block (&block);
+  tmp = build_call_expr (built_in_decls[frexp], 2, arg,
+			 build_fold_addr_expr (e));
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = fold_build2 (MINUS_EXPR, integer_type_node, e, prec);
+  gfc_add_modify_expr (&block, e, fold_build2 (MAX_EXPR, integer_type_node,
+					       tmp, emin));
+
+  tmp = build_call_expr (built_in_decls[scalbn], 2,
+			 build_real_from_int_cst (type, integer_one_node), e);
+  gfc_add_modify_expr (&block, res, tmp);
+
+  /* Finish by building the IF statement.  */
+  cond = fold_build2 (EQ_EXPR, boolean_type_node, arg,
+		      build_real_from_int_cst (type, integer_zero_node));
+  tmp = build3_v (COND_EXPR, cond, build2_v (MODIFY_EXPR, res, tiny),
+		  gfc_finish_block (&block));
+
+  gfc_add_expr_to_block (&se->pre, tmp);
+  se->expr = res;
+}
+
+
+/* RRSPACING (s) is translated into
+      int e;
+      real x;
+      x = fabs (s);
+      if (x != 0)
+      {
+	frexp (s, &e);
+	x = scalbn (x, precision - e);
+      }
+      return x;
+
+ where precision is gfc_real_kinds[k].digits.  */
+
+static void
+gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, e, x, cond, stmt, tmp;
+  int frexp, scalbn, fabs, prec, k;
+  stmtblock_t block;
+
+  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+  prec = gfc_real_kinds[k].digits;
+  switch (expr->ts.kind)
+    {
+      case 4:
+	frexp = BUILT_IN_FREXPF;
+	scalbn = BUILT_IN_SCALBNF;
+	fabs = BUILT_IN_FABSF;
+	break;
+      case 8:
+	frexp = BUILT_IN_FREXP;
+	scalbn = BUILT_IN_SCALBN;
+	fabs = BUILT_IN_FABS;
+	break;
+      case 10:
+      case 16:
+	frexp = BUILT_IN_FREXPL;
+	scalbn = BUILT_IN_SCALBNL;
+	fabs = BUILT_IN_FABSL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  e = gfc_create_var (integer_type_node, NULL);
+  x = gfc_create_var (type, NULL);
+  gfc_add_modify_expr (&se->pre, x,
+		       build_call_expr (built_in_decls[fabs], 1, arg));
+
+
+  gfc_start_block (&block);
+  tmp = build_call_expr (built_in_decls[frexp], 2, arg,
+			 build_fold_addr_expr (e));
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = fold_build2 (MINUS_EXPR, integer_type_node,
+		     build_int_cst (NULL_TREE, prec), e);
+  tmp = build_call_expr (built_in_decls[scalbn], 2, x, tmp);
+  gfc_add_modify_expr (&block, x, tmp);
+  stmt = gfc_finish_block (&block);
+
+  cond = fold_build2 (NE_EXPR, boolean_type_node, x,
+		      build_real_from_int_cst (type, integer_zero_node));
+  tmp = build3_v (COND_EXPR, cond, stmt, build_empty_stmt ());
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  se->expr = fold_convert (type, x);
+}
+
+
+/* SCALE (s, i) is translated into scalbn (s, i).  */
+static void
+gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type;
+  int scalbn;
+
+  switch (expr->ts.kind)
+    {
+      case 4:
+	scalbn = BUILT_IN_SCALBNF;
+	break;
+      case 8:
+	scalbn = BUILT_IN_SCALBN;
+	break;
+      case 10:
+      case 16:
+	scalbn = BUILT_IN_SCALBNL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  se->expr = build_call_expr (built_in_decls[scalbn], 2,
+			      fold_convert (type, args[0]),
+			      fold_convert (integer_type_node, args[1]));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* SET_EXPONENT (s, i) is translated into
+   scalbn (frexp (s, &dummy_int), i).  */
+static void
+gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, tmp;
+  int frexp, scalbn;
+
+  switch (expr->ts.kind)
+    {
+      case 4:
+	frexp = BUILT_IN_FREXPF;
+	scalbn = BUILT_IN_SCALBNF;
+	break;
+      case 8:
+	frexp = BUILT_IN_FREXP;
+	scalbn = BUILT_IN_SCALBN;
+	break;
+      case 10:
+      case 16:
+	frexp = BUILT_IN_FREXPL;
+	scalbn = BUILT_IN_SCALBNL;
+	break;
+      default:
+	gcc_unreachable ();
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  tmp = gfc_create_var (integer_type_node, NULL);
+  tmp = build_call_expr (built_in_decls[frexp], 2,
+			 fold_convert (type, args[0]),
+			 build_fold_addr_expr (tmp));
+  se->expr = build_call_expr (built_in_decls[scalbn], 2, tmp,
+			      fold_convert (integer_type_node, args[1]));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
 static void
 gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
 {
@@ -3899,6 +4184,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_fdate (se, expr);
       break;
 
+    case GFC_ISYM_FRACTION:
+      gfc_conv_intrinsic_fraction (se, expr);
+      break;
+
     case GFC_ISYM_IAND:
       gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR);
       break;
@@ -4037,6 +4326,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_minmaxval (se, expr, LT_EXPR);
       break;
 
+    case GFC_ISYM_NEAREST:
+      gfc_conv_intrinsic_nearest (se, expr);
+      break;
+
     case GFC_ISYM_NOT:
       gfc_conv_intrinsic_not (se, expr);
       break;
@@ -4053,6 +4346,18 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_arith (se, expr, MULT_EXPR);
       break;
 
+    case GFC_ISYM_RRSPACING:
+      gfc_conv_intrinsic_rrspacing (se, expr);
+      break;
+
+    case GFC_ISYM_SET_EXPONENT:
+      gfc_conv_intrinsic_set_exponent (se, expr);
+      break;
+
+    case GFC_ISYM_SCALE:
+      gfc_conv_intrinsic_scale (se, expr);
+      break;
+
     case GFC_ISYM_SIGN:
       gfc_conv_intrinsic_sign (se, expr);
       break;
@@ -4065,6 +4370,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_sizeof (se, expr);
       break;
 
+    case GFC_ISYM_SPACING:
+      gfc_conv_intrinsic_spacing (se, expr);
+      break;
+
     case GFC_ISYM_SUM:
       gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR);
       break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 72476888e6b..eac320a9e01 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -529,10 +529,6 @@ extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 extern GTY(()) tree gfor_fndecl_math_ishftc4;
 extern GTY(()) tree gfor_fndecl_math_ishftc8;
 extern GTY(()) tree gfor_fndecl_math_ishftc16;
-extern GTY(()) tree gfor_fndecl_math_exponent4;
-extern GTY(()) tree gfor_fndecl_math_exponent8;
-extern GTY(()) tree gfor_fndecl_math_exponent10;
-extern GTY(()) tree gfor_fndecl_math_exponent16;
 
 /* BLAS functions.  */
 extern GTY(()) tree gfor_fndecl_sgemm;