f95-lang.c (gfc_init_builtin_functions): Add more floating-point built-ins.

	* f95-lang.c (gfc_init_builtin_functions): Add more floating-point
	built-ins.
	* mathbuiltins.def (OTHER_BUILTIN): Define built-ins for logb,
	remainder, rint and signbit.
	* trans-decl.c (save_fp_state, restore_fp_state): Move to
	trans-intrinsic.c
	(gfc_generate_function_code): Use new names for these two functions.
	* trans-expr.c (gfc_conv_function_expr): Catch IEEE functions to
	emit code from the front-end.
	* trans-intrinsic.c (gfc_save_fp_state, gfc_restore_fp_state,
	conv_ieee_function_args, conv_intrinsic_ieee_builtin,
	conv_intrinsic_ieee_is_normal, conv_intrinsic_ieee_is_negative,
	conv_intrinsic_ieee_logb_rint, conv_intrinsic_ieee_rem,
	conv_intrinsic_ieee_next_after, conv_intrinsic_ieee_scalb,
	conv_intrinsic_ieee_copy_sign, gfc_conv_ieee_arithmetic_function):
	New functions.
	* trans.h (gfc_conv_ieee_arithmetic_function,
	gfc_save_fp_state, gfc_restore_fp_state): New prototypes.

	* ieee/ieee_helper.c (ieee_is_finite_*, ieee_is_nan_*,
	ieee_is_negative_*, ieee_is_normal_*, ieee_copy_sign_*,
	ieee_unordered_*, ieee_logb_*, ieee_rint_*, ieee_scalb_*,
	ieee_rem_*, ieee_next_after_*): Remove functions.
	* gfortran.map (GFORTRAN_1.5): Remove corresponding symbols.

From-SVN: r216036

gcc/fortran/ChangeLog

+2014-10-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* f95-lang.c (gfc_init_builtin_functions): Add more floating-point
+	built-ins.
+	* mathbuiltins.def (OTHER_BUILTIN): Define built-ins for logb,
+	remainder, rint and signbit.
+	* trans-decl.c (save_fp_state, restore_fp_state): Move to
+	trans-intrinsic.c
+	(gfc_generate_function_code): Use new names for these two functions.
+	* trans-expr.c (gfc_conv_function_expr): Catch IEEE functions to
+	emit code from the front-end.
+	* trans-intrinsic.c (gfc_save_fp_state, gfc_restore_fp_state,
+	conv_ieee_function_args, conv_intrinsic_ieee_builtin,
+	conv_intrinsic_ieee_is_normal, conv_intrinsic_ieee_is_negative,
+	conv_intrinsic_ieee_logb_rint, conv_intrinsic_ieee_rem,
+	conv_intrinsic_ieee_next_after, conv_intrinsic_ieee_scalb,
+	conv_intrinsic_ieee_copy_sign, gfc_conv_ieee_arithmetic_function):
+	New functions.
+	* trans.h (gfc_conv_ieee_arithmetic_function,
+	gfc_save_fp_state, gfc_restore_fp_state): New prototypes.
+
 2014-10-06  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR fortran/44054

gcc/fortran/f95-lang.c

@@ -563,6 +563,7 @@ gfc_builtin_function (tree decl)
 #define ATTR_NOTHROW_LEAF_LIST		(ECF_NOTHROW | ECF_LEAF)
 #define ATTR_NOTHROW_LEAF_MALLOC_LIST	(ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
 #define ATTR_CONST_NOTHROW_LEAF_LIST	(ECF_NOTHROW | ECF_LEAF | ECF_CONST)
+#define ATTR_PURE_NOTHROW_LEAF_LIST	(ECF_NOTHROW | ECF_LEAF | ECF_PURE)
 #define ATTR_NOTHROW_LIST		(ECF_NOTHROW)
 #define ATTR_CONST_NOTHROW_LIST		(ECF_NOTHROW | ECF_CONST)
 
@@ -683,6 +684,8 @@ gfc_init_builtin_functions (void)
   tree ftype, ptype;
   tree builtin_types[(int) BT_LAST + 1];
 
+  int attr;
+
   build_builtin_fntypes (mfunc_float, float_type_node);
   build_builtin_fntypes (mfunc_double, double_type_node);
   build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
@@ -770,6 +773,32 @@ gfc_init_builtin_functions (void)
 		      BUILT_IN_NEXTAFTERF, "nextafterf",
 		      ATTR_CONST_NOTHROW_LEAF_LIST);
  
+  /* Some built-ins depend on rounding mode. Depending on compilation options, they
+     will be "pure" or "const".  */
+  attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
+
+  gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0], 
+		      BUILT_IN_RINTL, "rintl", attr);
+  gfc_define_builtin ("__builtin_rint", mfunc_double[0], 
+		      BUILT_IN_RINT, "rint", attr);
+  gfc_define_builtin ("__builtin_rintf", mfunc_float[0], 
+		      BUILT_IN_RINTF, "rintf", attr);
+
+  gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1], 
+		      BUILT_IN_REMAINDERL, "remainderl", attr);
+  gfc_define_builtin ("__builtin_remainder", mfunc_double[1], 
+		      BUILT_IN_REMAINDER, "remainder", attr);
+  gfc_define_builtin ("__builtin_remainderf", mfunc_float[1], 
+		      BUILT_IN_REMAINDERF, "remainderf", attr);
+ 
+  gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0], 
+		      BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_logb", mfunc_double[0], 
+		      BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_logbf", mfunc_float[0], 
+		      BUILT_IN_LOGBF, "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+
   gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], 
 		      BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
   gfc_define_builtin ("__builtin_frexp", mfunc_double[4], 
@@ -960,6 +989,34 @@ gfc_init_builtin_functions (void)
                                     void_type_node, NULL_TREE);
   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
 		      "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_isfinite", ftype, BUILT_IN_ISFINITE,
+		      "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_isnormal", ftype, BUILT_IN_ISNORMAL,
+		      "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node, void_type_node,
+				    void_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
+		      "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
+		      "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_isgreaterequal", ftype,
+		      BUILT_IN_ISGREATEREQUAL, "__builtin_isgreaterequal",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    float_type_node, NULL_TREE); 
+  gfc_define_builtin("__builtin_signbitf", ftype, BUILT_IN_SIGNBITF,
+		     "signbitf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (integer_type_node,
+                                    double_type_node, NULL_TREE); 
+  gfc_define_builtin("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
+		     "signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (integer_type_node,
+                                    long_double_type_node, NULL_TREE); 
+  gfc_define_builtin("__builtin_signbitl", ftype, BUILT_IN_SIGNBITL,
+		     "signbitl", ATTR_CONST_NOTHROW_LEAF_LIST);
+
 
 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
   builtin_types[(int) ENUM] = VALUE;

gcc/fortran/mathbuiltins.def

@@ -62,11 +62,15 @@ OTHER_BUILTIN (CPOW,      "cpow",      cpow,    true)
 OTHER_BUILTIN (FABS,      "fabs",      1,       true)
 OTHER_BUILTIN (FMOD,      "fmod",      2,       true)
 OTHER_BUILTIN (FREXP,     "frexp",     frexp,   false)
+OTHER_BUILTIN (LOGB,      "logb",      1,       true)
 OTHER_BUILTIN (LLROUND,   "llround",   llround, true)
 OTHER_BUILTIN (LROUND,    "lround",    lround,  true)
 OTHER_BUILTIN (IROUND,    "iround",    iround,  true)
 OTHER_BUILTIN (NEXTAFTER, "nextafter", 2,       true)
-OTHER_BUILTIN (POW,       "pow",       1,       true)
+OTHER_BUILTIN (POW,       "pow",       2,       true)
+OTHER_BUILTIN (REMAINDER, "remainder", 2,       true)
+OTHER_BUILTIN (RINT,      "rint",      1,       true)
 OTHER_BUILTIN (ROUND,     "round",     1,       true)
 OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn,  true)
+OTHER_BUILTIN (SIGNBIT,   "signbit",   iround,  true)
 OTHER_BUILTIN (TRUNC,     "trunc",     1,       true)

gcc/fortran/trans-decl.c

@@ -5619,36 +5619,6 @@ is_ieee_module_used (gfc_namespace *ns)
 }
 
 
-static tree
-save_fp_state (stmtblock_t *block)
-{
-  tree type, fpstate, tmp;
-
-  type = build_array_type (char_type_node,
-	                   build_range_type (size_type_node, size_zero_node,
-					     size_int (32)));
-  fpstate = gfc_create_var (type, "fpstate");
-  fpstate = gfc_build_addr_expr (pvoid_type_node, fpstate);
-
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_entry,
-			     1, fpstate);
-  gfc_add_expr_to_block (block, tmp);
-
-  return fpstate;
-}
-
-
-static void
-restore_fp_state (stmtblock_t *block, tree fpstate)
-{
-  tree tmp;
-
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_exit,
-			     1, fpstate);
-  gfc_add_expr_to_block (block, tmp);
-}
-
-
 /* Generate code for a function.  */
 
 void
@@ -5760,7 +5730,7 @@ gfc_generate_function_code (gfc_namespace * ns)
      the floating point state.  */
   ieee = is_ieee_module_used (ns);
   if (ieee)
-    fpstate = save_fp_state (&init);
+    fpstate = gfc_save_fp_state (&init);
 
   /* Now generate the code for the body of this function.  */
   gfc_init_block (&body);
@@ -5847,7 +5817,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   /* If IEEE modules are loaded, restore the floating-point state.  */
   if (ieee)
-    restore_fp_state (&cleanup, fpstate);
+    gfc_restore_fp_state (&cleanup, fpstate);
 
   /* Finish the function body and add init and cleanup code.  */
   tmp = gfc_finish_block (&body);

gcc/fortran/trans-expr.c

@@ -5768,6 +5768,11 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
   if (!sym)
     sym = expr->symtree->n.sym;
 
+  /* The IEEE_ARITHMETIC functions are caught here. */
+  if (sym->from_intmod == INTMOD_IEEE_ARITHMETIC)
+    if (gfc_conv_ieee_arithmetic_function (se, expr))
+      return;
+
   /* We distinguish statement functions from general functions to improve
      runtime performance.  */
   if (sym->attr.proc == PROC_ST_FUNCTION)

gcc/fortran/trans-intrinsic.c

@@ -7171,6 +7171,342 @@ conv_isocbinding_subroutine (gfc_code *code)
 }
 
 
+/* Save and restore floating-point state.  */
+
+tree
+gfc_save_fp_state (stmtblock_t *block)
+{
+  tree type, fpstate, tmp;
+
+  type = build_array_type (char_type_node,
+	                   build_range_type (size_type_node, size_zero_node,
+					     size_int (GFC_FPE_STATE_BUFFER_SIZE)));
+  fpstate = gfc_create_var (type, "fpstate");
+  fpstate = gfc_build_addr_expr (pvoid_type_node, fpstate);
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_entry,
+			     1, fpstate);
+  gfc_add_expr_to_block (block, tmp);
+
+  return fpstate;
+}
+
+
+void
+gfc_restore_fp_state (stmtblock_t *block, tree fpstate)
+{
+  tree tmp;
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_ieee_procedure_exit,
+			     1, fpstate);
+  gfc_add_expr_to_block (block, tmp);
+}
+
+
+/* Generate code for arguments of IEEE functions.  */
+
+static void
+conv_ieee_function_args (gfc_se *se, gfc_expr *expr, tree *argarray,
+			 int nargs)
+{
+  gfc_actual_arglist *actual;
+  gfc_expr *e;
+  gfc_se argse;
+  int arg;
+
+  actual = expr->value.function.actual;
+  for (arg = 0; arg < nargs; arg++, actual = actual->next)
+    {
+      gcc_assert (actual);
+      e = actual->expr;
+
+      gfc_init_se (&argse, se);
+      gfc_conv_expr_val (&argse, e);
+
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      argarray[arg] = argse.expr;
+    }
+}
+
+
+/* Generate code for intrinsics IEEE_IS_NAN, IEEE_IS_FINITE,
+   and IEEE_UNORDERED, which translate directly to GCC type-generic
+   built-ins.  */
+
+static void
+conv_intrinsic_ieee_builtin (gfc_se * se, gfc_expr * expr,
+			     enum built_in_function code, int nargs)
+{
+  tree args[2];
+  gcc_assert ((unsigned) nargs <= sizeof(args)/sizeof(args[0]));
+
+  conv_ieee_function_args (se, expr, args, nargs);
+  se->expr = build_call_expr_loc_array (input_location,
+					builtin_decl_explicit (code),
+					nargs, args);
+  STRIP_TYPE_NOPS (se->expr);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Generate code for IEEE_IS_NORMAL intrinsic:
+     IEEE_IS_NORMAL(x) --> (__builtin_isnormal(x) || x == 0)  */
+
+static void
+conv_intrinsic_ieee_is_normal (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, isnormal, iszero;
+
+  /* Convert arg, evaluate it only once.  */
+  conv_ieee_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  isnormal = build_call_expr_loc (input_location,
+				  builtin_decl_explicit (BUILT_IN_ISNORMAL),
+				  1, arg);
+  iszero = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
+			    build_real_from_int_cst (TREE_TYPE (arg),
+						     integer_zero_node));
+  se->expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+			      boolean_type_node, isnormal, iszero);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Generate code for IEEE_IS_NEGATIVE intrinsic:
+     IEEE_IS_NEGATIVE(x) --> (__builtin_signbit(x) && !__builtin_isnan(x))  */
+
+static void
+conv_intrinsic_ieee_is_negative (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, signbit, isnan, decl;
+  int argprec;
+
+  /* Convert arg, evaluate it only once.  */
+  conv_ieee_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  isnan = build_call_expr_loc (input_location,
+			       builtin_decl_explicit (BUILT_IN_ISNAN),
+			       1, arg);
+  STRIP_TYPE_NOPS (isnan);
+
+  argprec = TYPE_PRECISION (TREE_TYPE (arg));
+  decl = builtin_decl_for_precision (BUILT_IN_SIGNBIT, argprec);
+  signbit = build_call_expr_loc (input_location, decl, 1, arg);
+  signbit = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     signbit, integer_zero_node);
+
+  se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			      boolean_type_node, signbit,
+			      fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+					       TREE_TYPE(isnan), isnan));
+
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Generate code for IEEE_LOGB and IEEE_RINT.  */
+
+static void
+conv_intrinsic_ieee_logb_rint (gfc_se * se, gfc_expr * expr,
+			       enum built_in_function code)
+{
+  tree arg, decl, call, fpstate;
+  int argprec;
+
+  conv_ieee_function_args (se, expr, &arg, 1);
+  argprec = TYPE_PRECISION (TREE_TYPE (arg));
+  decl = builtin_decl_for_precision (code, argprec);
+
+  /* Save floating-point state.  */
+  fpstate = gfc_save_fp_state (&se->pre);
+
+  /* Make the function call.  */
+  call = build_call_expr_loc (input_location, decl, 1, arg);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), call);
+
+  /* Restore floating-point state.  */
+  gfc_restore_fp_state (&se->post, fpstate);
+}
+
+
+/* Generate code for IEEE_REM.  */
+
+static void
+conv_intrinsic_ieee_rem (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], decl, call, fpstate;
+  int argprec;
+
+  conv_ieee_function_args (se, expr, args, 2);
+
+  /* If arguments have unequal size, convert them to the larger.  */
+  if (TYPE_PRECISION (TREE_TYPE (args[0]))
+      > TYPE_PRECISION (TREE_TYPE (args[1])))
+    args[1] = fold_convert (TREE_TYPE (args[0]), args[1]);
+  else if (TYPE_PRECISION (TREE_TYPE (args[1]))
+	   > TYPE_PRECISION (TREE_TYPE (args[0])))
+    args[0] = fold_convert (TREE_TYPE (args[1]), args[0]);
+
+  argprec = TYPE_PRECISION (TREE_TYPE (args[0]));
+  decl = builtin_decl_for_precision (BUILT_IN_REMAINDER, argprec);
+
+  /* Save floating-point state.  */
+  fpstate = gfc_save_fp_state (&se->pre);
+
+  /* Make the function call.  */
+  call = build_call_expr_loc_array (input_location, decl, 2, args);
+  se->expr = fold_convert (TREE_TYPE (args[0]), call);
+
+  /* Restore floating-point state.  */
+  gfc_restore_fp_state (&se->post, fpstate);
+}
+
+
+/* Generate code for IEEE_NEXT_AFTER.  */
+
+static void
+conv_intrinsic_ieee_next_after (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], decl, call, fpstate;
+  int argprec;
+
+  conv_ieee_function_args (se, expr, args, 2);
+
+  /* Result has the characteristics of first argument.  */
+  args[1] = fold_convert (TREE_TYPE (args[0]), args[1]);
+  argprec = TYPE_PRECISION (TREE_TYPE (args[0]));
+  decl = builtin_decl_for_precision (BUILT_IN_NEXTAFTER, argprec);
+
+  /* Save floating-point state.  */
+  fpstate = gfc_save_fp_state (&se->pre);
+
+  /* Make the function call.  */
+  call = build_call_expr_loc_array (input_location, decl, 2, args);
+  se->expr = fold_convert (TREE_TYPE (args[0]), call);
+
+  /* Restore floating-point state.  */
+  gfc_restore_fp_state (&se->post, fpstate);
+}
+
+
+/* Generate code for IEEE_SCALB.  */
+
+static void
+conv_intrinsic_ieee_scalb (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], decl, call, huge, type;
+  int argprec, n;
+
+  conv_ieee_function_args (se, expr, args, 2);
+
+  /* Result has the characteristics of first argument.  */
+  argprec = TYPE_PRECISION (TREE_TYPE (args[0]));
+  decl = builtin_decl_for_precision (BUILT_IN_SCALBN, argprec);
+
+  if (TYPE_PRECISION (TREE_TYPE (args[1])) > TYPE_PRECISION (integer_type_node))
+    {
+      /* We need to fold the integer into the range of a C int.  */
+      args[1] = gfc_evaluate_now (args[1], &se->pre);
+      type = TREE_TYPE (args[1]);
+
+      n = gfc_validate_kind (BT_INTEGER, gfc_c_int_kind, false);
+      huge = gfc_conv_mpz_to_tree (gfc_integer_kinds[n].huge,
+				   gfc_c_int_kind);
+      huge = fold_convert (type, huge);
+      args[1] = fold_build2_loc (input_location, MIN_EXPR, type, args[1],
+				 huge);
+      args[1] = fold_build2_loc (input_location, MAX_EXPR, type, args[1],
+				 fold_build1_loc (input_location, NEGATE_EXPR,
+						  type, huge));
+    }
+
+  args[1] = fold_convert (integer_type_node, args[1]);
+
+  /* Make the function call.  */
+  call = build_call_expr_loc_array (input_location, decl, 2, args);
+  se->expr = fold_convert (TREE_TYPE (args[0]), call);
+}
+
+
+/* Generate code for IEEE_COPY_SIGN.  */
+
+static void
+conv_intrinsic_ieee_copy_sign (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], decl, sign;
+  int argprec;
+
+  conv_ieee_function_args (se, expr, args, 2);
+
+  /* Get the sign of the second argument.  */
+  argprec = TYPE_PRECISION (TREE_TYPE (args[1]));
+  decl = builtin_decl_for_precision (BUILT_IN_SIGNBIT, argprec);
+  sign = build_call_expr_loc (input_location, decl, 1, args[1]);
+  sign = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			  sign, integer_zero_node);
+
+  /* Create a value of one, with the right sign.  */
+  sign = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			  sign,
+			  fold_build1_loc (input_location, NEGATE_EXPR,
+					   integer_type_node,
+					   integer_one_node),
+			  integer_one_node);
+  args[1] = fold_convert (TREE_TYPE (args[0]), sign);
+
+  argprec = TYPE_PRECISION (TREE_TYPE (args[0]));
+  decl = builtin_decl_for_precision (BUILT_IN_COPYSIGN, argprec);
+
+  se->expr = build_call_expr_loc_array (input_location, decl, 2, args);
+}
+
+
+/* Generate code for an intrinsic function from the IEEE_ARITHMETIC
+   module.  */
+
+bool
+gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
+{
+  const char *name = expr->value.function.name;
+
+#define STARTS_WITH(A,B) (strncmp((A), (B), strlen(B)) == 0)
+
+  if (STARTS_WITH (name, "_gfortran_ieee_is_nan"))
+    conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISNAN, 1);
+  else if (STARTS_WITH (name, "_gfortran_ieee_is_finite"))
+    conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISFINITE, 1);
+  else if (STARTS_WITH (name, "_gfortran_ieee_unordered"))
+    conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISUNORDERED, 2);
+  else if (STARTS_WITH (name, "_gfortran_ieee_is_normal"))
+    conv_intrinsic_ieee_is_normal (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_is_negative"))
+    conv_intrinsic_ieee_is_negative (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_copy_sign"))
+    conv_intrinsic_ieee_copy_sign (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_scalb"))
+    conv_intrinsic_ieee_scalb (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_next_after"))
+    conv_intrinsic_ieee_next_after (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_rem"))
+    conv_intrinsic_ieee_rem (se, expr);
+  else if (STARTS_WITH (name, "_gfortran_ieee_logb"))
+    conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_LOGB);
+  else if (STARTS_WITH (name, "_gfortran_ieee_rint"))
+    conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
+  else
+    /* It is not among the functions we translate directly.  We return
+       false, so a library function call is emitted.  */
+    return false;
+
+#undef STARTS_WITH
+
+  return true;
+}
+
+
 /* Generate code for an intrinsic function.  Some map directly to library
    calls, others get special handling.  In some cases the name of the function
    used depends on the type specifiers.  */

gcc/fortran/trans.h

@@ -437,6 +437,10 @@ tree size_of_string_in_bytes (int, tree);
 /* Intrinsic procedure handling.  */
 tree gfc_conv_intrinsic_subroutine (gfc_code *);
 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
+bool gfc_conv_ieee_arithmetic_function (gfc_se *, gfc_expr *);
+tree gfc_save_fp_state (stmtblock_t *);
+void gfc_restore_fp_state (stmtblock_t *, tree);
+
 
 /* Does an intrinsic map directly to an external library call
    This is true for array-returning intrinsics, unless
@@ -792,6 +796,10 @@ extern GTY(()) tree gfor_fndecl_sc_kind;
 extern GTY(()) tree gfor_fndecl_si_kind;
 extern GTY(()) tree gfor_fndecl_sr_kind;
 
+/* IEEE-related.  */
+extern GTY(()) tree gfor_fndecl_ieee_procedure_entry;
+extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
+
 
 /* True if node is an integer constant.  */
 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)

libgfortran/ChangeLog

+2014-10-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* ieee/ieee_helper.c (ieee_is_finite_*, ieee_is_nan_*,
+	ieee_is_negative_*, ieee_is_normal_*, ieee_copy_sign_*,
+	ieee_unordered_*, ieee_logb_*, ieee_rint_*, ieee_scalb_*,
+	ieee_rem_*, ieee_next_after_*): Remove functions.
+	* gfortran.map (GFORTRAN_1.5): Remove corresponding symbols.
+
 2014-10-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/63460

libgfortran/gfortran.map

@@ -1197,38 +1197,8 @@ GFORTRAN_1.5 {
 
 GFORTRAN_1.6 {
   global:
-    _gfortran_ieee_copy_sign_4_4_;
-    _gfortran_ieee_copy_sign_4_8_;
-    _gfortran_ieee_copy_sign_8_4_;
-    _gfortran_ieee_copy_sign_8_8_;
-    _gfortran_ieee_is_finite_4_;
-    _gfortran_ieee_is_finite_8_;
-    _gfortran_ieee_is_nan_4_;
-    _gfortran_ieee_is_nan_8_;
-    _gfortran_ieee_is_negative_4_;
-    _gfortran_ieee_is_negative_8_;
-    _gfortran_ieee_is_normal_4_;
-    _gfortran_ieee_is_normal_8_;
-    _gfortran_ieee_logb_4_;
-    _gfortran_ieee_logb_8_;
-    _gfortran_ieee_next_after_4_4_;
-    _gfortran_ieee_next_after_4_8_;
-    _gfortran_ieee_next_after_8_4_;
-    _gfortran_ieee_next_after_8_8_;
     _gfortran_ieee_procedure_entry;
     _gfortran_ieee_procedure_exit;
-    _gfortran_ieee_rem_4_4_;
-    _gfortran_ieee_rem_4_8_;
-    _gfortran_ieee_rem_8_4_;
-    _gfortran_ieee_rem_8_8_;
-    _gfortran_ieee_rint_4_;
-    _gfortran_ieee_rint_8_;
-    _gfortran_ieee_scalb_4_;
-    _gfortran_ieee_scalb_8_;
-    _gfortran_ieee_unordered_4_4_;
-    _gfortran_ieee_unordered_4_8_;
-    _gfortran_ieee_unordered_8_4_;
-    _gfortran_ieee_unordered_8_8_;
     __ieee_arithmetic_MOD_ieee_class_4;
     __ieee_arithmetic_MOD_ieee_class_8;
     __ieee_arithmetic_MOD_ieee_class_type_eq;

libgfortran/ieee/ieee_helper.c

@@ -33,31 +33,6 @@ internal_proto(ieee_class_helper_4);
 extern int ieee_class_helper_8 (GFC_REAL_8 *);
 internal_proto(ieee_class_helper_8);
 
-extern int ieee_is_finite_4_ (GFC_REAL_4 *);
-export_proto(ieee_is_finite_4_);
-
-extern int ieee_is_finite_8_ (GFC_REAL_8 *);
-export_proto(ieee_is_finite_8_);
-
-extern int ieee_is_nan_4_ (GFC_REAL_4 *);
-export_proto(ieee_is_nan_4_);
-
-extern int ieee_is_nan_8_ (GFC_REAL_8 *);
-export_proto(ieee_is_nan_8_);
-
-extern int ieee_is_negative_4_ (GFC_REAL_4 *);
-export_proto(ieee_is_negative_4_);
-
-extern int ieee_is_negative_8_ (GFC_REAL_8 *);
-export_proto(ieee_is_negative_8_);
-
-extern int ieee_is_normal_4_ (GFC_REAL_4 *);
-export_proto(ieee_is_normal_4_);
-
-extern int ieee_is_normal_8_ (GFC_REAL_8 *);
-export_proto(ieee_is_normal_8_);
-
-
 /* Enumeration of the possible floating-point types. These values
    correspond to the hidden arguments of the IEEE_CLASS_TYPE
    derived-type of IEEE_ARITHMETIC.  */
@@ -100,272 +75,6 @@ CLASSMACRO(4)
 CLASSMACRO(8)
 
 
-/* Testing functions.  */
-
-int ieee_is_finite_4_ (GFC_REAL_4 *val)
-{
-  return __builtin_isfinite(*val) ? 1 : 0;
-}
-
-int ieee_is_finite_8_ (GFC_REAL_8 *val)
-{
-  return __builtin_isfinite(*val) ? 1 : 0;
-}
-
-int ieee_is_nan_4_ (GFC_REAL_4 *val)
-{
-  return __builtin_isnan(*val) ? 1 : 0;
-}
-
-int ieee_is_nan_8_ (GFC_REAL_8 *val)
-{
-  return __builtin_isnan(*val) ? 1 : 0;
-}
-
-int ieee_is_negative_4_ (GFC_REAL_4 *val)
-{
-  return (__builtin_signbit(*val) && !__builtin_isnan(*val)) ? 1 : 0;
-}
-
-int ieee_is_negative_8_ (GFC_REAL_8 *val)
-{
-  return (__builtin_signbit(*val) && !__builtin_isnan(*val)) ? 1 : 0;
-}
-
-int ieee_is_normal_4_ (GFC_REAL_4 *val)
-{
-  return (__builtin_isnormal(*val) || *val == 0) ? 1 : 0;
-}
-
-int ieee_is_normal_8_ (GFC_REAL_8 *val)
-{
-  return (__builtin_isnormal(*val) || *val == 0) ? 1 : 0;
-}
-
-GFC_REAL_4 ieee_copy_sign_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
-export_proto(ieee_copy_sign_4_4_);
-GFC_REAL_4 ieee_copy_sign_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
-{
-  GFC_REAL_4 s = __builtin_signbit(*y) ? -1 : 1;
-  return __builtin_copysign(*x, s);
-}
-
-GFC_REAL_4 ieee_copy_sign_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
-export_proto(ieee_copy_sign_4_8_);
-GFC_REAL_4 ieee_copy_sign_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
-{
-  GFC_REAL_4 s = __builtin_signbit(*y) ? -1 : 1;
-  return __builtin_copysign(*x, s);
-}
-
-GFC_REAL_8 ieee_copy_sign_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
-export_proto(ieee_copy_sign_8_4_);
-GFC_REAL_8 ieee_copy_sign_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
-{
-  GFC_REAL_8 s = __builtin_signbit(*y) ? -1 : 1;
-  return __builtin_copysign(*x, s);
-}
-
-GFC_REAL_8 ieee_copy_sign_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
-export_proto(ieee_copy_sign_8_8_);
-GFC_REAL_8 ieee_copy_sign_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
-{
-  GFC_REAL_8 s = __builtin_signbit(*y) ? -1 : 1;
-  return __builtin_copysign(*x, s);
-}
-
-int ieee_unordered_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
-export_proto(ieee_unordered_4_4_);
-int ieee_unordered_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
-{
-  return __builtin_isunordered(*x, *y);
-}
-
-int ieee_unordered_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
-export_proto(ieee_unordered_4_8_);
-int ieee_unordered_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
-{
-  return __builtin_isunordered(*x, *y);
-}
-
-int ieee_unordered_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
-export_proto(ieee_unordered_8_4_);
-int ieee_unordered_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
-{
-  return __builtin_isunordered(*x, *y);
-}
-
-int ieee_unordered_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
-export_proto(ieee_unordered_8_8_);
-int ieee_unordered_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
-{
-  return __builtin_isunordered(*x, *y);
-}
-
-
-/* Arithmetic functions (LOGB, NEXT_AFTER, REM, RINT, SCALB).  */
-
-GFC_REAL_4 ieee_logb_4_ (GFC_REAL_4 *);
-export_proto(ieee_logb_4_);
-
-GFC_REAL_4 ieee_logb_4_ (GFC_REAL_4 *x)
-{
-  GFC_REAL_4 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_logb (*x);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_8 ieee_logb_8_ (GFC_REAL_8 *);
-export_proto(ieee_logb_8_);
-
-GFC_REAL_8 ieee_logb_8_ (GFC_REAL_8 *x)
-{
-  GFC_REAL_8 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_logb (*x);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_4 ieee_next_after_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
-export_proto(ieee_next_after_4_4_);
-
-GFC_REAL_4 ieee_next_after_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
-{
-  return __builtin_nextafterf (*x, *y);
-}
-
-GFC_REAL_4 ieee_next_after_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
-export_proto(ieee_next_after_4_8_);
-
-GFC_REAL_4 ieee_next_after_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
-{
-  return __builtin_nextafterf (*x, *y);
-}
-
-GFC_REAL_8 ieee_next_after_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
-export_proto(ieee_next_after_8_4_);
-
-GFC_REAL_8 ieee_next_after_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
-{
-  return __builtin_nextafter (*x, *y);
-}
-
-GFC_REAL_8 ieee_next_after_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
-export_proto(ieee_next_after_8_8_);
-
-GFC_REAL_8 ieee_next_after_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
-{
-  return __builtin_nextafter (*x, *y);
-}
-
-GFC_REAL_4 ieee_rem_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
-export_proto(ieee_rem_4_4_);
-
-GFC_REAL_4 ieee_rem_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
-{
-  GFC_REAL_4 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_remainderf (*x, *y);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_8 ieee_rem_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
-export_proto(ieee_rem_4_8_);
-
-GFC_REAL_8 ieee_rem_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
-{
-  GFC_REAL_8 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_remainder (*x, *y);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_8 ieee_rem_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
-export_proto(ieee_rem_8_4_);
-
-GFC_REAL_8 ieee_rem_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
-{
-  GFC_REAL_8 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_remainder (*x, *y);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_8 ieee_rem_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
-export_proto(ieee_rem_8_8_);
-
-GFC_REAL_8 ieee_rem_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
-{
-  GFC_REAL_8 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_remainder (*x, *y);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_4 ieee_rint_4_ (GFC_REAL_4 *);
-export_proto(ieee_rint_4_);
-
-GFC_REAL_4 ieee_rint_4_ (GFC_REAL_4 *x)
-{
-  GFC_REAL_4 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_rint (*x);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_8 ieee_rint_8_ (GFC_REAL_8 *);
-export_proto(ieee_rint_8_);
-
-GFC_REAL_8 ieee_rint_8_ (GFC_REAL_8 *x)
-{
-  GFC_REAL_8 res;
-  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
-
-  get_fpu_state (buffer);
-  res = __builtin_rint (*x);
-  set_fpu_state (buffer);
-  return res;
-}
-
-GFC_REAL_4 ieee_scalb_4_ (GFC_REAL_4 *, int *);
-export_proto(ieee_scalb_4_);
-
-GFC_REAL_4 ieee_scalb_4_ (GFC_REAL_4 *x, int *i)
-{
-  return __builtin_scalbnf (*x, *i);
-}
-
-GFC_REAL_8 ieee_scalb_8_ (GFC_REAL_8 *, int *);
-export_proto(ieee_scalb_8_);
-
-GFC_REAL_8 ieee_scalb_8_ (GFC_REAL_8 *x, int *i)
-{
-  return __builtin_scalbn (*x, *i);
-}
-
-
 #define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
 		     GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \
 		     GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT)