From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1665) id C4C323858CDB; Sat, 10 Sep 2022 10:13:14 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C4C323858CDB DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1662804794; bh=+Ue91G5J7O+eH0VJzLMvqgMEof0OjnvI04FtvWRk+cE=; h=From:To:Subject:Date:From; b=F14U5KBoEUA9cNYHMkpTkS56YUurksOm6pWRuBcdUNQXk54Vlbi9X2QGLyLowY11B ffoLqZxS7yGIb3V7UcCnKLyUXU7Oo2dc9qmtiaEENF+nKe9GNHgBDQRDH+7bbdN7Eq /3zr7Djg0Dr8bs1zb/fWxtCUZgl3h9MJjw9N3cRg= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: =?utf-8?q?Fran=E0=A4=A5=E0=A4=88ois-Xavier_Coudert?= To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-2577] fortran: Add IEEE_SIGNBIT and IEEE_FMA functions X-Act-Checkin: gcc X-Git-Author: Francois-Xavier Coudert X-Git-Refname: refs/heads/master X-Git-Oldrev: 861d1a11c0a052ddb3851950d3c0db86b320646d X-Git-Newrev: 7c4c65d11469d29403d5a88316445ec95cd3c3f8 Message-Id: <20220910101314.C4C323858CDB@sourceware.org> Date: Sat, 10 Sep 2022 10:13:14 +0000 (GMT) List-Id: https://gcc.gnu.org/g:7c4c65d11469d29403d5a88316445ec95cd3c3f8 commit r13-2577-g7c4c65d11469d29403d5a88316445ec95cd3c3f8 Author: Francois-Xavier Coudert Date: Wed Aug 31 15:22:50 2022 +0200 fortran: Add IEEE_SIGNBIT and IEEE_FMA functions The functions are added to the IEEE_ARITHMETIC module, but are entirely expanded in the front-end, using GCC built-ins. 2022-08-31 Francois-Xavier Coudert PR fortran/95644 gcc/fortran/ * f95-lang.cc (gfc_init_builtin_functions): Declare FMA built-ins. * mathbuiltins.def: Declare FMA built-ins. * trans-intrinsic.cc (conv_intrinsic_ieee_fma): New function. (conv_intrinsic_ieee_signbit): New function. (gfc_build_intrinsic_lib_fndecls): Add cases for FMA and SIGNBIT. gcc/testsuite/ * gfortran.dg/ieee/fma_1.f90: New test. * gfortran.dg/ieee/signbit_1.f90: New test. libgfortran/ * ieee/ieee_arithmetic.F90: Add IEEE_SIGNBIT and IEEE_FMA. Diff: --- gcc/fortran/f95-lang.cc | 16 +++ gcc/fortran/mathbuiltins.def | 1 + gcc/fortran/trans-intrinsic.cc | 51 +++++++- gcc/testsuite/gfortran.dg/ieee/fma_1.f90 | 100 ++++++++++++++++ gcc/testsuite/gfortran.dg/ieee/signbit_1.f90 | 166 +++++++++++++++++++++++++++ libgfortran/ieee/ieee_arithmetic.F90 | 66 +++++++++++ 6 files changed, 398 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 10ac8a95b87..ff4bf800e49 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -1281,6 +1281,22 @@ gfc_init_builtin_functions (void) "__builtin_assume_aligned", ATTR_CONST_NOTHROW_LEAF_LIST); + ftype = build_function_type_list (long_double_type_node, long_double_type_node, + long_double_type_node, long_double_type_node, + NULL_TREE); + gfc_define_builtin ("__builtin_fmal", ftype, BUILT_IN_FMAL, + "fmal", ATTR_CONST_NOTHROW_LEAF_LIST); + ftype = build_function_type_list (double_type_node, double_type_node, + double_type_node, double_type_node, + NULL_TREE); + gfc_define_builtin ("__builtin_fma", ftype, BUILT_IN_FMA, + "fma", ATTR_CONST_NOTHROW_LEAF_LIST); + ftype = build_function_type_list (float_type_node, float_type_node, + float_type_node, float_type_node, + NULL_TREE); + gfc_define_builtin ("__builtin_fmaf", ftype, BUILT_IN_FMAF, + "fmaf", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__emutls_get_address", builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS, diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index 615214ebcd6..9d55c34cda8 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -60,6 +60,7 @@ OTHER_BUILTIN (CABS, "cabs", cabs, true) OTHER_BUILTIN (COPYSIGN, "copysign", 2, true) OTHER_BUILTIN (CPOW, "cpow", cpow, true) OTHER_BUILTIN (FABS, "fabs", 1, true) +OTHER_BUILTIN (FMA, "fma", 3, true) OTHER_BUILTIN (FMOD, "fmod", 2, true) OTHER_BUILTIN (FREXP, "frexp", frexp, false) OTHER_BUILTIN (LOGB, "logb", 1, true) diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index ec116fff26e..bb938026828 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -695,7 +695,7 @@ gfc_build_intrinsic_lib_fndecls (void) C99-like library functions. For now, we only handle _Float128 q-suffixed or IEC 60559 f128-suffixed functions. */ - tree type, complex_type, func_1, func_2, func_cabs, func_frexp; + tree type, complex_type, func_1, func_2, func_3, func_cabs, func_frexp; tree func_iround, func_lround, func_llround, func_scalbn, func_cpow; memset (quad_decls, 0, sizeof(tree) * (END_BUILTINS + 1)); @@ -715,6 +715,8 @@ gfc_build_intrinsic_lib_fndecls (void) type, NULL_TREE); /* type (*) (type, type) */ func_2 = build_function_type_list (type, type, type, NULL_TREE); + /* type (*) (type, type, type) */ + func_3 = build_function_type_list (type, type, type, type, NULL_TREE); /* type (*) (type, &int) */ func_frexp = build_function_type_list (type, @@ -9781,7 +9783,7 @@ conv_ieee_function_args (gfc_se *se, gfc_expr *expr, tree *argarray, } -/* Generate code for intrinsics IEEE_IS_NAN, IEEE_IS_FINITE, +/* Generate code for intrinsics IEEE_IS_NAN, IEEE_IS_FINITE and IEEE_UNORDERED, which translate directly to GCC type-generic built-ins. */ @@ -9801,6 +9803,23 @@ conv_intrinsic_ieee_builtin (gfc_se * se, gfc_expr * expr, } +/* Generate code for intrinsics IEEE_SIGNBIT. */ + +static void +conv_intrinsic_ieee_signbit (gfc_se * se, gfc_expr * expr) +{ + tree arg, signbit; + + conv_ieee_function_args (se, expr, &arg, 1); + signbit = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_SIGNBIT), + 1, arg); + signbit = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + signbit, integer_zero_node); + se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), signbit); +} + + /* Generate code for IEEE_IS_NORMAL intrinsic: IEEE_IS_NORMAL(x) --> (__builtin_isnormal(x) || x == 0) */ @@ -10207,6 +10226,30 @@ conv_intrinsic_ieee_value (gfc_se *se, gfc_expr *expr) } +/* Generate code for IEEE_FMA. */ + +static void +conv_intrinsic_ieee_fma (gfc_se * se, gfc_expr * expr) +{ + tree args[3], decl, call; + int argprec; + + conv_ieee_function_args (se, expr, args, 3); + + /* All three arguments should have the same type. */ + gcc_assert (TYPE_PRECISION (TREE_TYPE (args[0])) == TYPE_PRECISION (TREE_TYPE (args[1]))); + gcc_assert (TYPE_PRECISION (TREE_TYPE (args[0])) == TYPE_PRECISION (TREE_TYPE (args[2]))); + + /* Call the type-generic FMA built-in. */ + argprec = TYPE_PRECISION (TREE_TYPE (args[0])); + decl = builtin_decl_for_precision (BUILT_IN_FMA, argprec); + call = build_call_expr_loc_array (input_location, decl, 3, args); + + /* Convert to the final type. */ + se->expr = fold_convert (TREE_TYPE (args[0]), call); +} + + /* Generate code for an intrinsic function from the IEEE_ARITHMETIC module. */ @@ -10221,6 +10264,8 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr) conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISFINITE, 1); else if (startswith (name, "_gfortran_ieee_unordered")) conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISUNORDERED, 2); + else if (startswith (name, "_gfortran_ieee_signbit")) + conv_intrinsic_ieee_signbit (se, expr); else if (startswith (name, "_gfortran_ieee_is_normal")) conv_intrinsic_ieee_is_normal (se, expr); else if (startswith (name, "_gfortran_ieee_is_negative")) @@ -10241,6 +10286,8 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr) conv_intrinsic_ieee_class (se, expr); else if (startswith (name, "ieee_value_") && ISDIGIT (name[11])) conv_intrinsic_ieee_value (se, expr); + else if (startswith (name, "_gfortran_ieee_fma")) + conv_intrinsic_ieee_fma (se, expr); else /* It is not among the functions we translate directly. We return false, so a library function call is emitted. */ diff --git a/gcc/testsuite/gfortran.dg/ieee/fma_1.f90 b/gcc/testsuite/gfortran.dg/ieee/fma_1.f90 new file mode 100644 index 00000000000..34636426c98 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/fma_1.f90 @@ -0,0 +1,100 @@ +! Test IEEE_FMA +! { dg-do run } + + use, intrinsic :: ieee_features + use, intrinsic :: ieee_exceptions + use, intrinsic :: ieee_arithmetic + implicit none + + integer :: ex + + real :: sx1, sx2, sx3 + double precision :: dx1, dx2, dx3 + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: lx1, lx2, lx3 + real(kind=k2) :: wx1, wx2, wx3 + + ! Float + + sx1 = 3 ; sx2 = 2 ; sx3 = 1 + if (ieee_fma(sx1, sx2, sx3) /= 7) stop 1 + sx1 = 0 ; sx2 = 2 ; sx3 = 1 + if (ieee_fma(sx1, sx2, sx3) /= 1) stop 2 + sx1 = 3 ; sx2 = 2 ; sx3 = 0 + if (ieee_fma(sx1, sx2, sx3) /= 6) stop 3 + + ex = int(log(rrspacing(real(1, kind(sx1)))) / log(real(2, kind(sx1)))) - 1 + sx1 = 1 + spacing(real(1, kind(sx1))) + sx2 = 2 ; sx2 = sx2 ** ex ; sx2 = sx2 * 3 + sx3 = -sx2 + + print *, sx1 * sx2 + sx3 + print *, ieee_fma(sx1, sx2, sx3) + if (ieee_fma(sx1, sx2, sx3) /= real(3, kind(sx1)) / 2) stop 4 + !if (ieee_fma(sx1, sx2, sx3) == sx1 * sx2 + sx3) stop 5 + + ! Double + + dx1 = 3 ; dx2 = 2 ; dx3 = 1 + if (ieee_fma(dx1, dx2, dx3) /= 7) stop 1 + dx1 = 0 ; dx2 = 2 ; dx3 = 1 + if (ieee_fma(dx1, dx2, dx3) /= 1) stop 2 + dx1 = 3 ; dx2 = 2 ; dx3 = 0 + if (ieee_fma(dx1, dx2, dx3) /= 6) stop 3 + + ex = int(log(rrspacing(real(1, kind(dx1)))) / log(real(2, kind(dx1)))) - 1 + dx1 = 1 + spacing(real(1, kind(dx1))) + dx2 = 2 ; dx2 = dx2 ** ex ; dx2 = dx2 * 3 + dx3 = -dx2 + + print *, dx1 * dx2 + dx3 + print *, ieee_fma(dx1, dx2, dx3) + if (ieee_fma(dx1, dx2, dx3) /= real(3, kind(dx1)) / 2) stop 4 + !if (ieee_fma(dx1, dx2, dx3) == dx1 * dx2 + dx3) stop 5 + + ! Large kind 1 + + lx1 = 3 ; lx2 = 2 ; lx3 = 1 + if (ieee_fma(lx1, lx2, lx3) /= 7) stop 1 + lx1 = 0 ; lx2 = 2 ; lx3 = 1 + if (ieee_fma(lx1, lx2, lx3) /= 1) stop 2 + lx1 = 3 ; lx2 = 2 ; lx3 = 0 + if (ieee_fma(lx1, lx2, lx3) /= 6) stop 3 + + ex = int(log(rrspacing(real(1, kind(lx1)))) / log(real(2, kind(lx1)))) - 1 + lx1 = 1 + spacing(real(1, kind(lx1))) + lx2 = 2 ; lx2 = lx2 ** ex ; lx2 = lx2 * 3 + lx3 = -lx2 + + print *, lx1 * lx2 + lx3 + print *, ieee_fma(lx1, lx2, lx3) + if (ieee_fma(lx1, lx2, lx3) /= real(3, kind(lx1)) / 2) stop 4 + if (ieee_fma(lx1, lx2, lx3) == lx1 * lx2 + lx3) stop 5 + + ! Large kind 2 + + wx1 = 3 ; wx2 = 2 ; wx3 = 1 + if (ieee_fma(wx1, wx2, wx3) /= 7) stop 1 + wx1 = 0 ; wx2 = 2 ; wx3 = 1 + if (ieee_fma(wx1, wx2, wx3) /= 1) stop 2 + wx1 = 3 ; wx2 = 2 ; wx3 = 0 + if (ieee_fma(wx1, wx2, wx3) /= 6) stop 3 + + ex = int(log(rrspacing(real(1, kind(wx1)))) / log(real(2, kind(wx1)))) - 1 + wx1 = 1 + spacing(real(1, kind(wx1))) + wx2 = 2 ; wx2 = wx2 ** ex ; wx2 = wx2 * 3 + wx3 = -wx2 + + print *, wx1 * wx2 + wx3 + print *, ieee_fma(wx1, wx2, wx3) + if (ieee_fma(wx1, wx2, wx3) /= real(3, kind(wx1)) / 2) stop 4 + if (ieee_fma(wx1, wx2, wx3) == wx1 * wx2 + wx3) stop 5 + +end diff --git a/gcc/testsuite/gfortran.dg/ieee/signbit_1.f90 b/gcc/testsuite/gfortran.dg/ieee/signbit_1.f90 new file mode 100644 index 00000000000..5d6e41de739 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/signbit_1.f90 @@ -0,0 +1,166 @@ +! Test IEEE_SIGNBIT +! { dg-do run } + + use, intrinsic :: ieee_features + use, intrinsic :: ieee_exceptions + use, intrinsic :: ieee_arithmetic + implicit none + + real :: sx1 + double precision :: dx1 + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: xk1 + real(kind=k2) :: xk2 + + ! Float + + sx1 = 1.3 + if (ieee_signbit(sx1)) stop 1 + sx1 = huge(sx1) + if (ieee_signbit(sx1)) stop 2 + sx1 = ieee_value(sx1, ieee_positive_inf) + if (ieee_signbit(sx1)) stop 3 + sx1 = tiny(sx1) + if (ieee_signbit(sx1)) stop 4 + sx1 = tiny(sx1) + sx1 = sx1 / 101 + if (ieee_signbit(sx1)) stop 5 + sx1 = 0 + if (ieee_signbit(sx1)) stop 6 + sx1 = ieee_value(sx1, ieee_quiet_nan) + if (ieee_signbit(sx1)) stop 7 + + sx1 = -1.3 + if (.not. ieee_signbit(sx1)) stop 8 + sx1 = -huge(sx1) + if (.not. ieee_signbit(sx1)) stop 9 + sx1 = -ieee_value(sx1, ieee_positive_inf) + if (.not. ieee_signbit(sx1)) stop 10 + sx1 = -tiny(sx1) + if (.not. ieee_signbit(sx1)) stop 11 + sx1 = -tiny(sx1) + sx1 = sx1 / 101 + if (.not. ieee_signbit(sx1)) stop 12 + sx1 = 0 + sx1 = -sx1 + if (.not. ieee_signbit(sx1)) stop 13 + sx1 = ieee_value(sx1, ieee_quiet_nan) + sx1 = -sx1 + if (.not. ieee_signbit(sx1)) stop 14 + + ! Double + + dx1 = 1.3 + if (ieee_signbit(dx1)) stop 1 + dx1 = huge(dx1) + if (ieee_signbit(dx1)) stop 2 + dx1 = ieee_value(dx1, ieee_positive_inf) + if (ieee_signbit(dx1)) stop 3 + dx1 = tiny(dx1) + if (ieee_signbit(dx1)) stop 4 + dx1 = tiny(dx1) + dx1 = dx1 / 101 + if (ieee_signbit(dx1)) stop 5 + dx1 = 0 + if (ieee_signbit(dx1)) stop 6 + dx1 = ieee_value(dx1, ieee_quiet_nan) + if (ieee_signbit(dx1)) stop 7 + + dx1 = -1.3 + if (.not. ieee_signbit(dx1)) stop 8 + dx1 = -huge(dx1) + if (.not. ieee_signbit(dx1)) stop 9 + dx1 = -ieee_value(dx1, ieee_positive_inf) + if (.not. ieee_signbit(dx1)) stop 10 + dx1 = -tiny(dx1) + if (.not. ieee_signbit(dx1)) stop 11 + dx1 = -tiny(dx1) + dx1 = dx1 / 101 + if (.not. ieee_signbit(dx1)) stop 12 + dx1 = 0 + dx1 = -dx1 + if (.not. ieee_signbit(dx1)) stop 13 + dx1 = ieee_value(dx1, ieee_quiet_nan) + dx1 = -dx1 + if (.not. ieee_signbit(dx1)) stop 14 + + ! Large kind 1 + + xk1 = 1.3 + if (ieee_signbit(xk1)) stop 1 + xk1 = huge(xk1) + if (ieee_signbit(xk1)) stop 2 + xk1 = ieee_value(xk1, ieee_positive_inf) + if (ieee_signbit(xk1)) stop 3 + xk1 = tiny(xk1) + if (ieee_signbit(xk1)) stop 4 + xk1 = tiny(xk1) + xk1 = xk1 / 101 + if (ieee_signbit(xk1)) stop 5 + xk1 = 0 + if (ieee_signbit(xk1)) stop 6 + xk1 = ieee_value(xk1, ieee_quiet_nan) + if (ieee_signbit(xk1)) stop 7 + + xk1 = -1.3 + if (.not. ieee_signbit(xk1)) stop 8 + xk1 = -huge(xk1) + if (.not. ieee_signbit(xk1)) stop 9 + xk1 = -ieee_value(xk1, ieee_positive_inf) + if (.not. ieee_signbit(xk1)) stop 10 + xk1 = -tiny(xk1) + if (.not. ieee_signbit(xk1)) stop 11 + xk1 = -tiny(xk1) + xk1 = xk1 / 101 + if (.not. ieee_signbit(xk1)) stop 12 + xk1 = 0 + xk1 = -xk1 + if (.not. ieee_signbit(xk1)) stop 13 + xk1 = ieee_value(xk1, ieee_quiet_nan) + xk1 = -xk1 + if (.not. ieee_signbit(xk1)) stop 14 + + ! Large kind 2 + + xk2 = 1.3 + if (ieee_signbit(xk2)) stop 1 + xk2 = huge(xk2) + if (ieee_signbit(xk2)) stop 2 + xk2 = ieee_value(xk2, ieee_positive_inf) + if (ieee_signbit(xk2)) stop 3 + xk2 = tiny(xk2) + if (ieee_signbit(xk2)) stop 4 + xk2 = tiny(xk2) + xk2 = xk2 / 101 + if (ieee_signbit(xk2)) stop 5 + xk2 = 0 + if (ieee_signbit(xk2)) stop 6 + xk2 = ieee_value(xk2, ieee_quiet_nan) + if (ieee_signbit(xk2)) stop 7 + + xk2 = -1.3 + if (.not. ieee_signbit(xk2)) stop 8 + xk2 = -huge(xk2) + if (.not. ieee_signbit(xk2)) stop 9 + xk2 = -ieee_value(xk2, ieee_positive_inf) + if (.not. ieee_signbit(xk2)) stop 10 + xk2 = -tiny(xk2) + if (.not. ieee_signbit(xk2)) stop 11 + xk2 = -tiny(xk2) + xk2 = xk2 / 101 + if (.not. ieee_signbit(xk2)) stop 12 + xk2 = 0 + xk2 = -xk2 + if (.not. ieee_signbit(xk2)) stop 13 + xk2 = ieee_value(xk2, ieee_quiet_nan) + xk2 = -xk2 + if (.not. ieee_signbit(xk2)) stop 14 + +end diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index c8ef3e2faeb..4e01aa5504c 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -343,6 +343,39 @@ UNORDERED_MACRO(4,4) end interface public :: IEEE_UNORDERED + ! IEEE_FMA + + interface + elemental real(kind=4) function _gfortran_ieee_fma_4 (A, B, C) + real(kind=4), intent(in) :: A, B, C + end function + elemental real(kind=8) function _gfortran_ieee_fma_8 (A, B, C) + real(kind=8), intent(in) :: A, B, C + end function +#ifdef HAVE_GFC_REAL_10 + elemental real(kind=10) function _gfortran_ieee_fma_10 (A, B, C) + real(kind=10), intent(in) :: A, B, C + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental real(kind=16) function _gfortran_ieee_fma_16 (A, B, C) + real(kind=16), intent(in) :: A, B, C + end function +#endif + end interface + + interface IEEE_FMA + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_fma_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_fma_10, & +#endif + _gfortran_ieee_fma_8, _gfortran_ieee_fma_4 + end interface + public :: IEEE_FMA + ! IEEE_LOGB interface @@ -702,6 +735,39 @@ REM_MACRO(4,4,4) end interface public :: IEEE_SCALB + ! IEEE_SIGNBIT + + interface + elemental logical function _gfortran_ieee_signbit_4 (X) + real(kind=4), intent(in) :: X + end function + elemental logical function _gfortran_ieee_signbit_8 (X) + real(kind=8), intent(in) :: X + end function +#ifdef HAVE_GFC_REAL_10 + elemental logical function _gfortran_ieee_signbit_10 (X) + real(kind=10), intent(in) :: X + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental logical function _gfortran_ieee_signbit_16 (X) + real(kind=16), intent(in) :: X + end function +#endif + end interface + + interface IEEE_SIGNBIT + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_signbit_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_signbit_10, & +#endif + _gfortran_ieee_signbit_8, _gfortran_ieee_signbit_4 + end interface + public :: IEEE_SIGNBIT + ! IEEE_VALUE interface IEEE_VALUE