From 3b7ea188c0457b2e70bdefc8cb53a790e7e9b296 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Thu, 9 Oct 2014 09:47:25 +0000 Subject: [PATCH] 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 | 21 +++ gcc/fortran/f95-lang.c | 57 ++++++ gcc/fortran/mathbuiltins.def | 6 +- gcc/fortran/trans-decl.c | 34 +--- gcc/fortran/trans-expr.c | 5 + gcc/fortran/trans-intrinsic.c | 336 +++++++++++++++++++++++++++++++++ gcc/fortran/trans.h | 8 + libgfortran/ChangeLog | 8 + libgfortran/gfortran.map | 30 --- libgfortran/ieee/ieee_helper.c | 291 ---------------------------- 10 files changed, 442 insertions(+), 354 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 113aaa747f8..68f47d4bbba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2014-10-09 Francois-Xavier Coudert + + * 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 PR fortran/44054 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 8e8591a5333..66cd3a33148 100644 --- a/gcc/fortran/f95-lang.c +++ b/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; diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index d5bf60dab1a..848da7cc763 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/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) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 718450430d3..92b350e10f6 100644 --- a/gcc/fortran/trans-decl.c +++ b/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); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6077a32dfac..18bc502a7c8 100644 --- a/gcc/fortran/trans-expr.c +++ b/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) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 0a3315d9cfa..b157b950ecc 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/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. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 03136e609be..70719e4bc8a 100644 --- a/gcc/fortran/trans.h +++ b/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) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 836afa52443..cf04401982e 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2014-10-09 Francois-Xavier Coudert + + * 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 PR libgfortran/63460 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 20f7f289b59..cfbfb160a52 100644 --- a/libgfortran/gfortran.map +++ b/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; diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c index f628add6b2e..023fbc38499 100644 --- a/libgfortran/ieee/ieee_helper.c +++ b/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) -- 2.30.2