mathbuiltins.def: Add builtins that do not directly correspond to a Fortran intrinsic...

	* mathbuiltins.def: Add builtins that do not directly correspond
	to a Fortran intrinsic, with new macro OTHER_BUILTIN.
	* f95-lang.c (gfc_init_builtin_functions): Define OTHER_BUILTIN.
	* trans-intrinsic.c (gfc_intrinsic_map_t): Remove
	code_{r,c}{4,8,10,16} fields. Add
	{,complex}{float,double,long_double}_built_in fields.
	(gfc_intrinsic_map): Adjust definitions of DEFINE_MATH_BUILTIN,
	DEFINE_MATH_BUILTIN_C and LIB_FUNCTION accordingly. Add
	definition of OTHER_BUILTIN.
	(real_compnt_info): Remove unused struct.
	(builtin_decl_for_precision, builtin_decl_for_float_kind): New
	functions.
	(build_round_expr): Call builtin_decl_for_precision instead of
	series of if-else.
	(gfc_conv_intrinsic_aint): Call builtin_decl_for_float_kind
	instead of a switch.
	(gfc_build_intrinsic_lib_fndecls): Match
	{real,complex}{4,8,10,16}decl into the C-style built_in_decls.
	(gfc_get_intrinsic_lib_fndecl): Do not hardcode floating-point
	kinds.
	(gfc_conv_intrinsic_lib_function): Go through all the extended
	gfc_intrinsic_map.
	(gfc_trans_same_strlen_check): Call builtin_decl_for_float_kind
	instead of a switch.
	(gfc_conv_intrinsic_abs): Likewise.
	(gfc_conv_intrinsic_mod): Likewise.
	(gfc_conv_intrinsic_sign): Likewise.
	(gfc_conv_intrinsic_fraction): Likewise.
	(gfc_conv_intrinsic_nearest): Likewise.
	(gfc_conv_intrinsic_spacing): Likewise.
	(gfc_conv_intrinsic_rrspacing): Likewise.
	(gfc_conv_intrinsic_scale): Likewise.
	(gfc_conv_intrinsic_set_exponent): Likewise.

From-SVN: r160628

4 files changed, 217 insertions, 343 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6f17693..19d0c6d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,39 @@
+2010-06-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* mathbuiltins.def: Add builtins that do not directly correspond
+	to a Fortran intrinsic, with new macro OTHER_BUILTIN.
+	* f95-lang.c (gfc_init_builtin_functions): Define OTHER_BUILTIN.
+	* trans-intrinsic.c (gfc_intrinsic_map_t): Remove
+	code_{r,c}{4,8,10,16} fields. Add
+	{,complex}{float,double,long_double}_built_in fields.
+	(gfc_intrinsic_map): Adjust definitions of DEFINE_MATH_BUILTIN,
+	DEFINE_MATH_BUILTIN_C and LIB_FUNCTION accordingly. Add
+	definition of OTHER_BUILTIN.
+	(real_compnt_info): Remove unused struct.
+	(builtin_decl_for_precision, builtin_decl_for_float_kind): New
+	functions.
+	(build_round_expr): Call builtin_decl_for_precision instead of
+	series of if-else.
+	(gfc_conv_intrinsic_aint): Call builtin_decl_for_float_kind
+	instead of a switch.
+	(gfc_build_intrinsic_lib_fndecls): Match
+	{real,complex}{4,8,10,16}decl into the C-style built_in_decls.
+	(gfc_get_intrinsic_lib_fndecl): Do not hardcode floating-point
+	kinds.
+	(gfc_conv_intrinsic_lib_function): Go through all the extended
+	gfc_intrinsic_map.
+	(gfc_trans_same_strlen_check): Call builtin_decl_for_float_kind
+	instead of a switch.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_mod): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_fraction): Likewise.
+	(gfc_conv_intrinsic_nearest): Likewise.
+	(gfc_conv_intrinsic_spacing): Likewise.
+	(gfc_conv_intrinsic_rrspacing): Likewise.
+	(gfc_conv_intrinsic_scale): Likewise.
+	(gfc_conv_intrinsic_set_exponent): Likewise.
+
 2010-06-11  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/42051
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index f31e846..a97016a 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -753,6 +753,9 @@ gfc_init_builtin_functions (void)
   func_longdouble_longdoublep_longdoublep =
     build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
 
+/* Non-math builtins are defined manually, so they're not included here.  */
+#define OTHER_BUILTIN(ID,NAME,TYPE)
+
 #include "mathbuiltins.def"
 
   gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], 
diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def
index 3bedc1a..2d6e967 100644
--- a/gcc/fortran/mathbuiltins.def
+++ b/gcc/fortran/mathbuiltins.def
@@ -51,3 +51,20 @@ DEFINE_MATH_BUILTIN   (ERFC,  "erfc",   0)
 DEFINE_MATH_BUILTIN   (TGAMMA,"tgamma", 0)
 DEFINE_MATH_BUILTIN   (LGAMMA,"lgamma", 0)
 DEFINE_MATH_BUILTIN   (HYPOT, "hypot",  1)
+
+/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE)
+   For floating-point builtins that do not directly correspond to a
+   Fortran intrinsic. This is used to map the different variants (float,
+   double and long double) and to build the quad-precision decls.  */
+OTHER_BUILTIN (CABS,      "cabs",      cabs)
+OTHER_BUILTIN (COPYSIGN,  "copysign",  2)
+OTHER_BUILTIN (FABS,      "fabs",      1)
+OTHER_BUILTIN (FMOD,      "fmod",      2)
+OTHER_BUILTIN (FREXP,     "frexp",     frexp)
+OTHER_BUILTIN (HUGE_VAL,  "huge_val",  0)
+OTHER_BUILTIN (LLROUND,   "llround",   llround)
+OTHER_BUILTIN (LROUND,    "lround",    lround)
+OTHER_BUILTIN (NEXTAFTER, "nextafter", 2)
+OTHER_BUILTIN (ROUND,     "round",     1)
+OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn)
+OTHER_BUILTIN (TRUNC,     "trunc",     1)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 94dcc29..8418d2b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -50,14 +50,12 @@ typedef struct GTY(()) gfc_intrinsic_map_t {
 
   /* Enum value from the "language-independent", aka C-centric, part
      of gcc, or END_BUILTINS of no such value set.  */
-  enum built_in_function code_r4;
-  enum built_in_function code_r8;
-  enum built_in_function code_r10;
-  enum built_in_function code_r16;
-  enum built_in_function code_c4;
-  enum built_in_function code_c8;
-  enum built_in_function code_c10;
-  enum built_in_function code_c16;
+  enum built_in_function float_built_in;
+  enum built_in_function double_built_in;
+  enum built_in_function long_double_built_in;
+  enum built_in_function complex_float_built_in;
+  enum built_in_function complex_double_built_in;
+  enum built_in_function complex_long_double_built_in;
 
   /* True if the naming pattern is to prepend "c" for complex and
      append "f" for kind=4.  False if the naming pattern is to
@@ -90,28 +88,33 @@ gfc_intrinsic_map_t;
    except for atan2.  */
 #define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \
   { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
-    BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, (enum built_in_function) 0, \
-    (enum built_in_function) 0, (enum built_in_function) 0, \
-    (enum built_in_function) 0, true, false, true, NAME, NULL_TREE, \
-    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
-    NULL_TREE},
+    BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    true, false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
 
 #define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \
   { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
-    BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, \
-    BUILT_IN_C ## ID, BUILT_IN_C ## ID ## L, BUILT_IN_C ## ID ## L, true, \
-    true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
-    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+    BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, BUILT_IN_C ## ID, \
+    BUILT_IN_C ## ID ## L, true, true, true, NAME, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
 
 #define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+  { GFC_ISYM_ ## ID, 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 }
 
+#define OTHER_BUILTIN(ID, NAME, TYPE) \
+  { GFC_ISYM_NONE, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    true, false, 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.  */
+  /* Functions built into gcc itself (DEFINE_MATH_BUILTIN and
+     DEFINE_MATH_BUILTIN_C), then the built-ins that don't correspond
+     to any GFC_ISYM id directly, which use the OTHER_BUILTIN macro.  */
 #include "mathbuiltins.def"
 
   /* Functions in libgfortran.  */
@@ -121,30 +124,45 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
   LIB_FUNCTION (NONE, NULL, false)
 
 };
+#undef OTHER_BUILTIN
 #undef LIB_FUNCTION
 #undef DEFINE_MATH_BUILTIN
 #undef DEFINE_MATH_BUILTIN_C
 
-/* Structure for storing components of a floating number to be used by
-   elemental functions to manipulate reals.  */
-typedef struct
+
+enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
+
+
+/* Find the correct variant of a given builtin from its argument.  */
+static tree
+builtin_decl_for_precision (enum built_in_function base_built_in,
+			    int precision)
+{
+  int i = END_BUILTINS;
+
+  gfc_intrinsic_map_t *m;
+  for (m = gfc_intrinsic_map; m->double_built_in != base_built_in ; m++)
+    ;
+
+  if (precision == TYPE_PRECISION (float_type_node))
+    i = m->float_built_in;
+  else if (precision == TYPE_PRECISION (double_type_node))
+    i = m->double_built_in;
+  else if (precision == TYPE_PRECISION (long_double_type_node))
+    i = m->long_double_built_in;
+
+  return (i == END_BUILTINS ? NULL_TREE : built_in_decls[i]);
+}
+
+
+static tree
+builtin_decl_for_float_kind (enum built_in_function double_built_in, int kind)
 {
-  tree arg;     /* Variable tree to view convert to integer.  */
-  tree expn;    /* Variable tree to save exponent.  */
-  tree frac;    /* Variable tree to save fraction.  */
-  tree smask;   /* Constant tree of sign's mask.  */
-  tree emask;   /* Constant tree of exponent's mask.  */
-  tree fmask;   /* Constant tree of fraction's mask.  */
-  tree edigits; /* Constant tree of the number of exponent bits.  */
-  tree fdigits; /* Constant tree of the number of fraction bits.  */
-  tree f1;      /* Constant tree of the f1 defined in the real model.  */
-  tree bias;    /* Constant tree of the bias of exponent in the memory.  */
-  tree type;    /* Type tree of arg1.  */
-  tree mtype;   /* Type tree of integer type. Kind is that of arg1.  */
+  int i = gfc_validate_kind (BT_REAL, kind, false);
+  return builtin_decl_for_precision (double_built_in,
+				     gfc_real_kinds[i].mode_precision);
 }
-real_compnt_info;
 
-enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
 
 /* Evaluate the arguments to an intrinsic function.  The value
    of NARGS may be less than the actual number of arguments in EXPR
@@ -353,14 +371,10 @@ build_round_expr (tree arg, tree restype)
     gcc_unreachable ();
 
   /* Now, depending on the argument type, we choose between intrinsics.  */
-  if (argprec == TYPE_PRECISION (float_type_node))
-    fn = built_in_decls[longlong ? BUILT_IN_LLROUNDF : BUILT_IN_LROUNDF];
-  else if (argprec == TYPE_PRECISION (double_type_node))
-    fn = built_in_decls[longlong ? BUILT_IN_LLROUND : BUILT_IN_LROUND];
-  else if (argprec == TYPE_PRECISION (long_double_type_node))
-    fn = built_in_decls[longlong ? BUILT_IN_LLROUNDL : BUILT_IN_LROUNDL];
+  if (longlong)
+    fn = builtin_decl_for_precision (BUILT_IN_LLROUND, argprec);
   else
-    gcc_unreachable ();
+    fn = builtin_decl_for_precision (BUILT_IN_LROUND, argprec);
 
   return fold_convert (restype, build_call_expr_loc (input_location,
 						 fn, 1, arg));
@@ -416,6 +430,7 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
   tree arg[2];
   tree tmp;
   tree cond;
+  tree decl;
   mpfr_t huge;
   int n, nargs;
   int kind;
@@ -423,44 +438,16 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
   kind = expr->ts.kind;
   nargs =  gfc_intrinsic_argument_list_length (expr);
 
-  n = END_BUILTINS;
+  decl = NULL_TREE;
   /* We have builtin functions for some cases.  */
   switch (op)
     {
     case RND_ROUND:
-      switch (kind)
-	{
-	case 4:
-	  n = BUILT_IN_ROUNDF;
-	  break;
-
-	case 8:
-	  n = BUILT_IN_ROUND;
-	  break;
-
-	case 10:
-	case 16:
-	  n = BUILT_IN_ROUNDL;
-	  break;
-	}
+      decl = builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
       break;
 
     case RND_TRUNC:
-      switch (kind)
-	{
-	case 4:
-	  n = BUILT_IN_TRUNCF;
-	  break;
-
-	case 8:
-	  n = BUILT_IN_TRUNC;
-	  break;
-
-	case 10:
-	case 16:
-	  n = BUILT_IN_TRUNCL;
-	  break;
-	}
+      decl = builtin_decl_for_float_kind (BUILT_IN_TRUNC, kind);
       break;
 
     default:
@@ -472,11 +459,9 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
   gfc_conv_intrinsic_function_args (se, expr, arg, nargs);
 
   /* Use a builtin function if one exists.  */
-  if (n != END_BUILTINS)
+  if (decl != NULL_TREE)
     {
-      tmp = built_in_decls[n];
-      se->expr = build_call_expr_loc (input_location,
-				  tmp, 1, arg[0]);
+      se->expr = build_call_expr_loc (input_location, decl, 1, arg[0]);
       return;
     }
 
@@ -580,24 +565,30 @@ gfc_build_intrinsic_lib_fndecls (void)
   gfc_intrinsic_map_t *m;
 
   /* Add GCC builtin functions.  */
-  for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
+  for (m = gfc_intrinsic_map;
+       m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
     {
-      if (m->code_r4 != END_BUILTINS)
-	m->real4_decl = built_in_decls[m->code_r4];
-      if (m->code_r8 != END_BUILTINS)
-	m->real8_decl = built_in_decls[m->code_r8];
-      if (m->code_r10 != END_BUILTINS)
-	m->real10_decl = built_in_decls[m->code_r10];
-      if (m->code_r16 != END_BUILTINS)
-	m->real16_decl = built_in_decls[m->code_r16];
-      if (m->code_c4 != END_BUILTINS)
-	m->complex4_decl = built_in_decls[m->code_c4];
-      if (m->code_c8 != END_BUILTINS)
-	m->complex8_decl = built_in_decls[m->code_c8];
-      if (m->code_c10 != END_BUILTINS)
-	m->complex10_decl = built_in_decls[m->code_c10];
-      if (m->code_c16 != END_BUILTINS)
-	m->complex16_decl = built_in_decls[m->code_c16];
+      if (m->float_built_in != END_BUILTINS)
+	m->real4_decl = built_in_decls[m->float_built_in];
+      if (m->complex_float_built_in != END_BUILTINS)
+	m->complex4_decl = built_in_decls[m->complex_float_built_in];
+      if (m->double_built_in != END_BUILTINS)
+	m->real8_decl = built_in_decls[m->double_built_in];
+      if (m->complex_double_built_in != END_BUILTINS)
+	m->complex8_decl = built_in_decls[m->complex_double_built_in];
+
+      /* If real(kind=10) exists, it is always long double.  */
+      if (m->long_double_built_in != END_BUILTINS)
+	m->real10_decl = built_in_decls[m->long_double_built_in];
+      if (m->complex_long_double_built_in != END_BUILTINS)
+	m->complex10_decl = built_in_decls[m->complex_long_double_built_in];
+
+      /* For now, we assume that if real(kind=10) exists, it is long double.
+	 Later, we will deal with __float128 and break this assumption.  */
+      if (m->long_double_built_in != END_BUILTINS)
+	m->real16_decl = built_in_decls[m->long_double_built_in];
+      if (m->complex_long_double_built_in != END_BUILTINS)
+	m->complex16_decl = built_in_decls[m->complex_long_double_built_in];
     }
 }
 
@@ -666,18 +657,18 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 
   if (m->libm_name)
     {
-      if (ts->kind == 4)
+      int n = gfc_validate_kind (BT_REAL, ts->kind, false);
+      if (gfc_real_kinds[n].c_float)
 	snprintf (name, sizeof (name), "%s%s%s",
-		ts->type == BT_COMPLEX ? "c" : "", m->name, "f");
-      else if (ts->kind == 8)
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "f");
+      else if (gfc_real_kinds[n].c_double)
 	snprintf (name, sizeof (name), "%s%s",
-		ts->type == BT_COMPLEX ? "c" : "", m->name);
+		  ts->type == BT_COMPLEX ? "c" : "", m->name);
+      else if (gfc_real_kinds[n].c_long_double)
+	snprintf (name, sizeof (name), "%s%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "l");
       else
-	{
-	  gcc_assert (ts->kind == 10 || ts->kind == 16);
-	  snprintf (name, sizeof (name), "%s%s%s",
-		ts->type == BT_COMPLEX ? "c" : "", m->name, "l");
-	}
+	gcc_unreachable ();
     }
   else
     {
@@ -725,7 +716,8 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
 
   id = expr->value.function.isym->id;
   /* Find the entry for this function.  */
-  for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
+  for (m = gfc_intrinsic_map;
+       m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
     {
       if (id == m->id)
 	break;
@@ -787,31 +779,16 @@ gfc_trans_same_strlen_check (const char* intr_name, locus* where,
 static void
 gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
 {
-  tree arg, type, res, tmp;
-  int frexp;
+  tree arg, type, res, tmp, frexp;
 
-  switch (expr->value.function.actual->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 ();
-    }
+  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP,
+				       expr->value.function.actual->expr->ts.kind);
 
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
 
   res = gfc_create_var (integer_type_node, NULL);
-  tmp = build_call_expr_loc (input_location,
-			 built_in_decls[frexp], 2, arg,
-			 gfc_build_addr_expr (NULL_TREE, res));
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, res));
   gfc_add_expr_to_block (&se->pre, tmp);
 
   type = gfc_typenode_for_spec (&expr->ts);
@@ -991,8 +968,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
 static void
 gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
 {
-  tree arg;
-  int n;
+  tree arg, cabs;
 
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
 
@@ -1004,23 +980,8 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
       break;
 
     case BT_COMPLEX:
-      switch (expr->ts.kind)
-	{
-	case 4:
-	  n = BUILT_IN_CABSF;
-	  break;
-	case 8:
-	  n = BUILT_IN_CABS;
-	  break;
-	case 10:
-	case 16:
-	  n = BUILT_IN_CABSL;
-	  break;
-	default:
-	  gcc_unreachable ();
-	}
-      se->expr = build_call_expr_loc (input_location,
-				  built_in_decls[n], 1, arg);
+      cabs = builtin_decl_for_float_kind (BUILT_IN_CABS, expr->ts.kind);
+      se->expr = build_call_expr_loc (input_location, cabs, 1, arg);
       break;
 
     default:
@@ -1072,6 +1033,7 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
   tree tmp;
   tree test;
   tree test2;
+  tree fmod;
   mpfr_t huge;
   int n, ikind;
   tree args[2];
@@ -1091,33 +1053,16 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
       break;
 
     case BT_REAL:
-      n = END_BUILTINS;
+      fmod = NULL_TREE;
       /* Check if we have a builtin fmod.  */
-      switch (expr->ts.kind)
-	{
-	case 4:
-	  n = BUILT_IN_FMODF;
-	  break;
-
-	case 8:
-	  n = BUILT_IN_FMOD;
-	  break;
-
-	case 10:
-	case 16:
-	  n = BUILT_IN_FMODL;
-	  break;
-
-	default:
-	  break;
-	}
+      fmod = builtin_decl_for_float_kind (BUILT_IN_FMOD, expr->ts.kind);
 
       /* Use it if it exists.  */
-      if (n != END_BUILTINS)
+      if (fmod != NULL_TREE)
 	{
-  	  tmp = build_addr (built_in_decls[n], current_function_decl);
+  	  tmp = build_addr (fmod, current_function_decl);
 	  se->expr = build_call_array_loc (input_location,
-				       TREE_TYPE (TREE_TYPE (built_in_decls[n])),
+				       TREE_TYPE (TREE_TYPE (fmod)),
                                        tmp, 2, args);
 	  if (modulo == 0)
 	    return;
@@ -1135,7 +1080,7 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
 	  test  = (fmod (arg, arg2) != 0) && ((arg < 0) xor (arg2 < 0))
 	 thereby avoiding another division and retaining the accuracy
 	 of the builtin function.  */
-      if (n != END_BUILTINS && modulo)
+      if (fmod != NULL_TREE && modulo)
 	{
 	  tree zero = gfc_build_const (type, integer_zero_node);
 	  tmp = gfc_evaluate_now (se->expr, &se->pre);
@@ -1232,24 +1177,8 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
     {
       tree abs;
 
-      switch (expr->ts.kind)
-	{
-	case 4:
-	  tmp = built_in_decls[BUILT_IN_COPYSIGNF];
-	  abs = built_in_decls[BUILT_IN_FABSF];
-	  break;
-	case 8:
-	  tmp = built_in_decls[BUILT_IN_COPYSIGN];
-	  abs = built_in_decls[BUILT_IN_FABS];
-	  break;
-	case 10:
-	case 16:
-	  tmp = built_in_decls[BUILT_IN_COPYSIGNL];
-	  abs = built_in_decls[BUILT_IN_FABSL];
-	  break;
-	default:
-	  gcc_unreachable ();
-	}
+      tmp = builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+      abs = builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
 
       /* We explicitly have to ignore the minus sign. We do so by using
 	 result = (arg1 == 0) ? abs(arg0) : copysign(arg0, arg1).  */
@@ -1264,8 +1193,8 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
 				  build_call_expr (tmp, 2, args[0], args[1]));
 	}
       else
-        se->expr = build_call_expr_loc (input_location,
-				  tmp, 2, args[0], args[1]);
+        se->expr = build_call_expr_loc (input_location, tmp, 2,
+					args[0], args[1]);
       return;
     }
 
@@ -3620,32 +3549,16 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
 {
-  tree arg, type, tmp;
-  int frexp;
+  tree arg, type, tmp, 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 ();
-    }
+  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
 
   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_loc (input_location,
-			      built_in_decls[frexp], 2,
-			      fold_convert (type, arg),
-			      gfc_build_addr_expr (NULL_TREE, tmp));
+  se->expr = build_call_expr_loc (input_location, frexp, 2,
+				  fold_convert (type, arg),
+				  gfc_build_addr_expr (NULL_TREE, tmp));
   se->expr = fold_convert (type, se->expr);
 }
 
@@ -3657,41 +3570,19 @@ gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_nearest (gfc_se * se, gfc_expr * expr)
 {
-  tree args[2], type, tmp;
-  int nextafter, copysign, huge_val;
+  tree args[2], type, tmp, nextafter, copysign, huge_val;
 
-  switch (expr->ts.kind)
-    {
-      case 4:
-	nextafter = BUILT_IN_NEXTAFTERF;
-	copysign = BUILT_IN_COPYSIGNF;
-	huge_val = BUILT_IN_HUGE_VALF;
-	break;
-      case 8:
-	nextafter = BUILT_IN_NEXTAFTER;
-	copysign = BUILT_IN_COPYSIGN;
-	huge_val = BUILT_IN_HUGE_VAL;
-	break;
-      case 10:
-      case 16:
-	nextafter = BUILT_IN_NEXTAFTERL;
-	copysign = BUILT_IN_COPYSIGNL;
-	huge_val = BUILT_IN_HUGE_VALL;
-	break;
-      default:
-	gcc_unreachable ();
-    }
+  nextafter = builtin_decl_for_float_kind (BUILT_IN_NEXTAFTER, expr->ts.kind);
+  copysign = builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+  huge_val = builtin_decl_for_float_kind (BUILT_IN_HUGE_VAL, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
-  tmp = build_call_expr_loc (input_location,
-			 built_in_decls[copysign], 2,
-			 build_call_expr_loc (input_location,
-					  built_in_decls[huge_val], 0),
-			 fold_convert (type, args[1]));
-  se->expr = build_call_expr_loc (input_location,
-			      built_in_decls[nextafter], 2,
-			      fold_convert (type, args[0]), tmp);
+  tmp = build_call_expr_loc (input_location, copysign, 2,
+			     build_call_expr_loc (input_location, huge_val, 0),
+			     fold_convert (type, args[1]));
+  se->expr = build_call_expr_loc (input_location, nextafter, 2,
+				  fold_convert (type, args[0]), tmp);
   se->expr = fold_convert (type, se->expr);
 }
 
@@ -3717,8 +3608,8 @@ 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;
+  tree cond, tmp, frexp, scalbn;
+  int k;
   stmtblock_t block;
 
   k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
@@ -3726,24 +3617,8 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
   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, 0);
 
-  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 ();
-    }
+  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
   arg = gfc_evaluate_now (arg, &se->pre);
@@ -3755,17 +3630,15 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
 
   /* Build the block for s /= 0.  */
   gfc_start_block (&block);
-  tmp = build_call_expr_loc (input_location,
-			 built_in_decls[frexp], 2, arg,
-			 gfc_build_addr_expr (NULL_TREE, e));
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, e));
   gfc_add_expr_to_block (&block, tmp);
 
   tmp = fold_build2 (MINUS_EXPR, integer_type_node, e, prec);
   gfc_add_modify (&block, e, fold_build2 (MAX_EXPR, integer_type_node,
 					  tmp, emin));
 
-  tmp = build_call_expr_loc (input_location,
-			 built_in_decls[scalbn], 2,
+  tmp = build_call_expr_loc (input_location, scalbn, 2,
 			 build_real_from_int_cst (type, integer_one_node), e);
   gfc_add_modify (&block, res, tmp);
 
@@ -3796,33 +3669,16 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
 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;
+  tree arg, type, e, x, cond, stmt, tmp, frexp, scalbn, fabs;
+  int 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 ();
-    }
+
+  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  fabs = builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
@@ -3831,20 +3687,17 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
   e = gfc_create_var (integer_type_node, NULL);
   x = gfc_create_var (type, NULL);
   gfc_add_modify (&se->pre, x,
-		  build_call_expr_loc (input_location,
-				   built_in_decls[fabs], 1, arg));
+		  build_call_expr_loc (input_location, fabs, 1, arg));
 
 
   gfc_start_block (&block);
-  tmp = build_call_expr_loc (input_location,
-			 built_in_decls[frexp], 2, arg,
-			 gfc_build_addr_expr (NULL_TREE, e));
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, 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_loc (input_location,
-			 built_in_decls[scalbn], 2, x, tmp);
+  tmp = build_call_expr_loc (input_location, scalbn, 2, x, tmp);
   gfc_add_modify (&block, x, tmp);
   stmt = gfc_finish_block (&block);
 
@@ -3861,31 +3714,15 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr)
 {
-  tree args[2], type;
-  int scalbn;
+  tree args[2], type, 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 ();
-    }
+  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
-  se->expr = build_call_expr_loc (input_location,
-			      built_in_decls[scalbn], 2,
-			      fold_convert (type, args[0]),
-			      fold_convert (integer_type_node, args[1]));
+  se->expr = build_call_expr_loc (input_location, scalbn, 2,
+				  fold_convert (type, args[0]),
+				  fold_convert (integer_type_node, args[1]));
   se->expr = fold_convert (type, se->expr);
 }
 
@@ -3895,39 +3732,20 @@ gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr)
 {
-  tree args[2], type, tmp;
-  int frexp, scalbn;
+  tree args[2], type, tmp, 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 ();
-    }
+  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   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_loc (input_location,
-			 built_in_decls[frexp], 2,
-			 fold_convert (type, args[0]),
-			 gfc_build_addr_expr (NULL_TREE, tmp));
-  se->expr = build_call_expr_loc (input_location,
-			      built_in_decls[scalbn], 2, tmp,
-			      fold_convert (integer_type_node, args[1]));
+  tmp = build_call_expr_loc (input_location, frexp, 2,
+			     fold_convert (type, args[0]),
+			     gfc_build_addr_expr (NULL_TREE, tmp));
+  se->expr = build_call_expr_loc (input_location, scalbn, 2, tmp,
+				  fold_convert (integer_type_node, args[1]));
   se->expr = fold_convert (type, se->expr);
 }