mirror of git://gcc.gnu.org/git/gcc.git
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
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
f9d29866b5
commit
3b7ea188c0
|
|
@ -1,3 +1,24 @@
|
||||||
|
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>
|
2014-10-06 Manuel López-Ibáñez <manu@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/44054
|
PR fortran/44054
|
||||||
|
|
|
||||||
|
|
@ -563,6 +563,7 @@ gfc_builtin_function (tree decl)
|
||||||
#define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
|
#define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
|
||||||
#define ATTR_NOTHROW_LEAF_MALLOC_LIST (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
|
#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_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_NOTHROW_LIST (ECF_NOTHROW)
|
||||||
#define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
|
#define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
|
||||||
|
|
||||||
|
|
@ -683,6 +684,8 @@ gfc_init_builtin_functions (void)
|
||||||
tree ftype, ptype;
|
tree ftype, ptype;
|
||||||
tree builtin_types[(int) BT_LAST + 1];
|
tree builtin_types[(int) BT_LAST + 1];
|
||||||
|
|
||||||
|
int attr;
|
||||||
|
|
||||||
build_builtin_fntypes (mfunc_float, float_type_node);
|
build_builtin_fntypes (mfunc_float, float_type_node);
|
||||||
build_builtin_fntypes (mfunc_double, double_type_node);
|
build_builtin_fntypes (mfunc_double, double_type_node);
|
||||||
build_builtin_fntypes (mfunc_longdouble, long_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",
|
BUILT_IN_NEXTAFTERF, "nextafterf",
|
||||||
ATTR_CONST_NOTHROW_LEAF_LIST);
|
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],
|
gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
|
||||||
BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
|
BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
|
||||||
gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
|
gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
|
||||||
|
|
@ -960,6 +989,34 @@ gfc_init_builtin_functions (void)
|
||||||
void_type_node, NULL_TREE);
|
void_type_node, NULL_TREE);
|
||||||
gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
|
gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
|
||||||
"__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
|
"__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) \
|
#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
|
||||||
builtin_types[(int) ENUM] = VALUE;
|
builtin_types[(int) ENUM] = VALUE;
|
||||||
|
|
|
||||||
|
|
@ -62,11 +62,15 @@ OTHER_BUILTIN (CPOW, "cpow", cpow, true)
|
||||||
OTHER_BUILTIN (FABS, "fabs", 1, true)
|
OTHER_BUILTIN (FABS, "fabs", 1, true)
|
||||||
OTHER_BUILTIN (FMOD, "fmod", 2, true)
|
OTHER_BUILTIN (FMOD, "fmod", 2, true)
|
||||||
OTHER_BUILTIN (FREXP, "frexp", frexp, false)
|
OTHER_BUILTIN (FREXP, "frexp", frexp, false)
|
||||||
|
OTHER_BUILTIN (LOGB, "logb", 1, true)
|
||||||
OTHER_BUILTIN (LLROUND, "llround", llround, true)
|
OTHER_BUILTIN (LLROUND, "llround", llround, true)
|
||||||
OTHER_BUILTIN (LROUND, "lround", lround, true)
|
OTHER_BUILTIN (LROUND, "lround", lround, true)
|
||||||
OTHER_BUILTIN (IROUND, "iround", iround, true)
|
OTHER_BUILTIN (IROUND, "iround", iround, true)
|
||||||
OTHER_BUILTIN (NEXTAFTER, "nextafter", 2, 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 (ROUND, "round", 1, true)
|
||||||
OTHER_BUILTIN (SCALBN, "scalbn", scalbn, true)
|
OTHER_BUILTIN (SCALBN, "scalbn", scalbn, true)
|
||||||
|
OTHER_BUILTIN (SIGNBIT, "signbit", iround, true)
|
||||||
OTHER_BUILTIN (TRUNC, "trunc", 1, true)
|
OTHER_BUILTIN (TRUNC, "trunc", 1, true)
|
||||||
|
|
|
||||||
|
|
@ -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. */
|
/* Generate code for a function. */
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
@ -5760,7 +5730,7 @@ gfc_generate_function_code (gfc_namespace * ns)
|
||||||
the floating point state. */
|
the floating point state. */
|
||||||
ieee = is_ieee_module_used (ns);
|
ieee = is_ieee_module_used (ns);
|
||||||
if (ieee)
|
if (ieee)
|
||||||
fpstate = save_fp_state (&init);
|
fpstate = gfc_save_fp_state (&init);
|
||||||
|
|
||||||
/* Now generate the code for the body of this function. */
|
/* Now generate the code for the body of this function. */
|
||||||
gfc_init_block (&body);
|
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 modules are loaded, restore the floating-point state. */
|
||||||
if (ieee)
|
if (ieee)
|
||||||
restore_fp_state (&cleanup, fpstate);
|
gfc_restore_fp_state (&cleanup, fpstate);
|
||||||
|
|
||||||
/* Finish the function body and add init and cleanup code. */
|
/* Finish the function body and add init and cleanup code. */
|
||||||
tmp = gfc_finish_block (&body);
|
tmp = gfc_finish_block (&body);
|
||||||
|
|
|
||||||
|
|
@ -5768,6 +5768,11 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
|
||||||
if (!sym)
|
if (!sym)
|
||||||
sym = expr->symtree->n.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
|
/* We distinguish statement functions from general functions to improve
|
||||||
runtime performance. */
|
runtime performance. */
|
||||||
if (sym->attr.proc == PROC_ST_FUNCTION)
|
if (sym->attr.proc == PROC_ST_FUNCTION)
|
||||||
|
|
|
||||||
|
|
@ -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
|
/* Generate code for an intrinsic function. Some map directly to library
|
||||||
calls, others get special handling. In some cases the name of the function
|
calls, others get special handling. In some cases the name of the function
|
||||||
used depends on the type specifiers. */
|
used depends on the type specifiers. */
|
||||||
|
|
|
||||||
|
|
@ -437,6 +437,10 @@ tree size_of_string_in_bytes (int, tree);
|
||||||
/* Intrinsic procedure handling. */
|
/* Intrinsic procedure handling. */
|
||||||
tree gfc_conv_intrinsic_subroutine (gfc_code *);
|
tree gfc_conv_intrinsic_subroutine (gfc_code *);
|
||||||
void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
|
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
|
/* Does an intrinsic map directly to an external library call
|
||||||
This is true for array-returning intrinsics, unless
|
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_si_kind;
|
||||||
extern GTY(()) tree gfor_fndecl_sr_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. */
|
/* True if node is an integer constant. */
|
||||||
#define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
|
#define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
|
||||||
|
|
|
||||||
|
|
@ -1,3 +1,11 @@
|
||||||
|
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>
|
2014-10-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||||
|
|
||||||
PR libgfortran/63460
|
PR libgfortran/63460
|
||||||
|
|
|
||||||
|
|
@ -1197,38 +1197,8 @@ GFORTRAN_1.5 {
|
||||||
|
|
||||||
GFORTRAN_1.6 {
|
GFORTRAN_1.6 {
|
||||||
global:
|
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_entry;
|
||||||
_gfortran_ieee_procedure_exit;
|
_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_4;
|
||||||
__ieee_arithmetic_MOD_ieee_class_8;
|
__ieee_arithmetic_MOD_ieee_class_8;
|
||||||
__ieee_arithmetic_MOD_ieee_class_type_eq;
|
__ieee_arithmetic_MOD_ieee_class_type_eq;
|
||||||
|
|
|
||||||
|
|
@ -33,31 +33,6 @@ internal_proto(ieee_class_helper_4);
|
||||||
extern int ieee_class_helper_8 (GFC_REAL_8 *);
|
extern int ieee_class_helper_8 (GFC_REAL_8 *);
|
||||||
internal_proto(ieee_class_helper_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
|
/* Enumeration of the possible floating-point types. These values
|
||||||
correspond to the hidden arguments of the IEEE_CLASS_TYPE
|
correspond to the hidden arguments of the IEEE_CLASS_TYPE
|
||||||
derived-type of IEEE_ARITHMETIC. */
|
derived-type of IEEE_ARITHMETIC. */
|
||||||
|
|
@ -100,272 +75,6 @@ CLASSMACRO(4)
|
||||||
CLASSMACRO(8)
|
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 | \
|
#define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
|
||||||
GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \
|
GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \
|
||||||
GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT)
|
GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue