public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: "Franथईois-Xavier Coudert" <fxcoudert@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-6616] Fortran: xfail signaling NaN testcases on x87 Date: Sun, 16 Jan 2022 23:03:05 +0000 (GMT) [thread overview] Message-ID: <20220116230305.A2E9D385840E@sourceware.org> (raw) https://gcc.gnu.org/g:86e3b476d5defaa79c94d40b76cbeec21cd02e5f commit r12-6616-g86e3b476d5defaa79c94d40b76cbeec21cd02e5f Author: Francois-Xavier Coudert <fxcoudert@gmail.com> Date: Mon Jan 17 00:00:18 2022 +0100 Fortran: xfail signaling NaN testcases on x87 The ABI for x87 and x86-32 is not suitable for passing around signaling NaNs in the way IEEE expects. See for example discussion in https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57484 gcc/testsuite/ChangeLog: * gfortran.dg/ieee/signaling_1.f90: xfail on x87. * gfortran.dg/ieee/signaling_2.f90: xfail on x87. Diff: --- gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 | 6 +- gcc/testsuite/gfortran.dg/ieee/signaling_2.f90 | 6 +- gcc/testsuite/gfortran.dg/ieee/signaling_3.f90 | 42 +++++ libgfortran/ieee/issignaling_fallback.h | 238 +++++++++++++++++++++++++ 4 files changed, 288 insertions(+), 4 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 b/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 index 93c8e183a2a..94ece3a4f61 100644 --- a/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 +++ b/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 @@ -1,8 +1,10 @@ -! { dg-do run } +! { dg-do run { xfail { { i?86-*-* x86_64-*-* } && ilp32 } } } +! x87 / x86-32 ABI is unsuitable for signaling NaNs +! ! { dg-require-effective-target issignaling } */ ! { dg-additional-sources signaling_1_c.c } ! { dg-additional-options "-w" } -! the -w option is needed to make cc1 not report a warning for +! The -w option is needed to make cc1 not report a warning for ! the -fintrinsic-modules-path option passed by ieee.exp ! program test diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_2.f90 b/gcc/testsuite/gfortran.dg/ieee/signaling_2.f90 index e7e7a4a10f2..ff37ab6e13e 100644 --- a/gcc/testsuite/gfortran.dg/ieee/signaling_2.f90 +++ b/gcc/testsuite/gfortran.dg/ieee/signaling_2.f90 @@ -1,8 +1,10 @@ -! { dg-do run } +! { dg-do run { xfail { { i?86-*-* x86_64-*-* } && ilp32 } } } +! x87 / x86-32 ABI is unsuitable for signaling NaNs +! ! { dg-require-effective-target issignaling } */ ! { dg-additional-sources signaling_2_c.c } ! { dg-additional-options "-w" } -! the -w option is needed to make cc1 not report a warning for +! The -w option is needed to make cc1 not report a warning for ! the -fintrinsic-modules-path option passed by ieee.exp ! program test diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_3.f90 b/gcc/testsuite/gfortran.dg/ieee/signaling_3.f90 new file mode 100644 index 00000000000..45bd9c3599f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/signaling_3.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! +program test + use, intrinsic :: iso_c_binding + use, intrinsic :: ieee_arithmetic + implicit none + + real(kind=c_float) :: x + real(kind=c_double) :: y + real(kind=c_long_double) :: z + + if (ieee_support_nan(x)) then + x = ieee_value(x, ieee_signaling_nan) + if (ieee_class(x) /= ieee_signaling_nan) stop 100 + if (.not. ieee_is_nan(x)) stop 101 + + x = ieee_value(x, ieee_quiet_nan) + if (ieee_class(x) /= ieee_quiet_nan) stop 103 + if (.not. ieee_is_nan(x)) stop 104 + end if + + if (ieee_support_nan(y)) then + y = ieee_value(y, ieee_signaling_nan) + if (ieee_class(y) /= ieee_signaling_nan) stop 100 + if (.not. ieee_is_nan(y)) stop 101 + + y = ieee_value(y, ieee_quiet_nan) + if (ieee_class(y) /= ieee_quiet_nan) stop 103 + if (.not. ieee_is_nan(y)) stop 104 + end if + + if (ieee_support_nan(z)) then + z = ieee_value(z, ieee_signaling_nan) + if (ieee_class(z) /= ieee_signaling_nan) stop 100 + if (.not. ieee_is_nan(z)) stop 101 + + z = ieee_value(z, ieee_quiet_nan) + if (ieee_class(z) /= ieee_quiet_nan) stop 103 + if (.not. ieee_is_nan(z)) stop 104 + end if + +end program test diff --git a/libgfortran/ieee/issignaling_fallback.h b/libgfortran/ieee/issignaling_fallback.h new file mode 100644 index 00000000000..e824cf8c59b --- /dev/null +++ b/libgfortran/ieee/issignaling_fallback.h @@ -0,0 +1,238 @@ +/* Fallback implementation of issignaling macro. + Copyright (C) 2022 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" + +/* This header provides an implementation of the type-generic issignaling macro. + Some points of note: + + - This header is only included if the issignaling macro is not defined. + - All targets for which Fortran IEEE modules are supported currently have + the high-order bit of the NaN mantissa clear for signaling (and set + for quiet), as recommended by IEEE. + - We use the __*_IS_IEC_60559__ macros to make sure we only deal with formats + we know. For other floating-point formats, we consider all NaNs as quiet. + + */ + +typedef union +{ + float value; + uint32_t word; +} ieee_float_shape_type; + +static inline int +__issignalingf (float x) +{ +#if __FLT_IS_IEC_60559__ + uint32_t xi; + ieee_float_shape_type u; + + u.value = x; + xi = u.word; + + xi ^= 0x00400000; + return (xi & 0x7fffffff) > 0x7fc00000; +#else + return 0; +#endif +} + + +typedef union +{ + double value; + uint64_t word; +} ieee_double_shape_type; + +static inline int +__issignaling (double x) +{ +#if __DBL_IS_IEC_60559__ + ieee_double_shape_type u; + uint64_t xi; + + u.value = x; + xi = u.word; + + xi ^= UINT64_C (0x0008000000000000); + return (xi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7ff8000000000000); +#else + return 0; +#endif +} + + +#if __LDBL_DIG__ == __DBL_DIG__ + +/* Long double is the same as double. */ +static inline int +__issignalingl (long double x) +{ + return __issignaling (x); +} + +#elif (__LDBL_DIG__ == 18) && __LDBL_IS_IEC_60559__ + +/* Long double is x86 extended type. */ + +typedef union +{ + long double value; + struct + { +#if __FLOAT_WORD_ORDER == __BIG_ENDIAN + int sign_exponent:16; + unsigned int empty:16; + uint32_t msw; + uint32_t lsw; +#elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN + uint32_t lsw; + uint32_t msw; + int sign_exponent:16; + unsigned int empty:16; +#endif + } parts; +} ieee_long_double_shape_type; + +static inline int +__issignalingl (long double x) +{ + int ret; + uint32_t exi, hxi, lxi; + ieee_long_double_shape_type u; + + u.value = x; + exi = u.parts.sign_exponent; + hxi = u.parts.msw; + lxi = u.parts.lsw; + + /* Pseudo numbers on x86 are always signaling. */ + ret = (exi & 0x7fff) && ((hxi & 0x80000000) == 0); + + hxi ^= 0x40000000; + hxi |= (lxi | -lxi) >> 31; + return ret || (((exi & 0x7fff) == 0x7fff) && (hxi > 0xc0000000)); +} + +#elif (__LDBL_DIG__ = 33) && __LDBL_IS_IEC_60559__ + +/* Long double is 128-bit type. */ + +typedef union +{ + long double value; + struct + { +#if __FLOAT_WORD_ORDER == __BIG_ENDIAN + uint64_t msw; + uint64_t lsw; +#elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN + uint64_t lsw; + uint64_t msw; +#endif + } parts64; +} ieee854_long_double_shape_type; + +static inline int +__issignalingl (long double x) +{ + uint64_t hxi, lxi; + ieee854_long_double_shape_type u; + + u.value = x; + hxi = u.parts64.msw; + lxi = u.parts64.lsw; + + hxi ^= UINT64_C (0x0000800000000000); + hxi |= (lxi | -lxi) >> 63; + return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000); +} + +#else + +static inline int +__issignalingl (long double x) +{ + return 0; +} + +#endif + + +#if __FLT128_IS_IEC_60559__ + +/* We have a _Float128 type. */ + +typedef union +{ + __float128 value; + struct + { +#if __FLOAT_WORD_ORDER == __BIG_ENDIAN + uint64_t msw; + uint64_t lsw; +#elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN + uint64_t lsw; + uint64_t msw; +#endif + } parts64; +} ieee854_float128_shape_type; + +static inline int +__issignalingf128 (__float128 x) +{ + uint64_t hxi, lxi; + ieee854_float128_shape_type u; + + u.value = x; + hxi = u.parts64.msw; + lxi = u.parts64.lsw; + + hxi ^= UINT64_C (0x0000800000000000); + hxi |= (lxi | -lxi) >> 63; + return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000); +} + +#endif + + +/* Define the type-generic macro based on the functions above. */ + +#if __FLT128_IS_IEC_60559__ +# define issignaling(X) \ + _Generic ((X), \ + __float128: __issignalingf128, \ + float: __issignalingf, \ + double: __issignaling, \ + long double: __issignalingl)(X) +#else +# define issignaling(X) \ + _Generic ((X), \ + float: __issignalingf, \ + double: __issignaling, \ + long double: __issignalingl)(X) +#endif +
reply other threads:[~2022-01-16 23:03 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20220116230305.A2E9D385840E@sourceware.org \ --to=fxcoudert@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).