From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 48) id 25B34386EC68; Thu, 4 Mar 2021 02:04:00 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 25B34386EC68 From: "kargl at gcc dot gnu.org" To: gcc-bugs@gcc.gnu.org Subject: [Bug fortran/95644] [F2018] IEEE_FMA is missing from the IEEE_ARITHMETIC module Date: Thu, 04 Mar 2021 02:04:00 +0000 X-Bugzilla-Reason: CC X-Bugzilla-Type: changed X-Bugzilla-Watch-Reason: None X-Bugzilla-Product: gcc X-Bugzilla-Component: fortran X-Bugzilla-Version: 9.3.0 X-Bugzilla-Keywords: X-Bugzilla-Severity: normal X-Bugzilla-Who: kargl at gcc dot gnu.org X-Bugzilla-Status: NEW X-Bugzilla-Resolution: X-Bugzilla-Priority: P4 X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org X-Bugzilla-Target-Milestone: --- X-Bugzilla-Flags: X-Bugzilla-Changed-Fields: Message-ID: In-Reply-To: References: Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/ Auto-Submitted: auto-generated MIME-Version: 1.0 X-BeenThere: gcc-bugs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-bugs mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 04 Mar 2021 02:04:00 -0000 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=3D95644 --- Comment #9 from kargl at gcc dot gnu.org --- (In reply to kargl from comment #8) >=20 > Short of someone diving in, there is always the kludge of ... >=20 This is a better kludge, but is far from the correct approach as gfortran should use the __builtin_fma() family of functions. But, this works for at least static linking. I did not update the symbol map for dynamic linking. I also did not test the libquadmath portion. ENOTIME. diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 35a16938f8e..3d686863e90 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -39,7 +39,7 @@ module IEEE_ARITHMETIC IEEE_DIVIDE_BY_ZERO, IEEE_UNDERFLOW, IEEE_INEXACT, IEEE_USUAL, & IEEE_ALL, IEEE_STATUS_TYPE, IEEE_GET_FLAG, IEEE_GET_HALTING_MODE, & IEEE_GET_STATUS, IEEE_SET_FLAG, IEEE_SET_HALTING_MODE, & - IEEE_SET_STATUS, IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING + IEEE_SET_STATUS, IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING, IEEE_FMA ! Derived types and named constants @@ -88,6 +88,17 @@ module IEEE_ARITHMETIC end interface public :: operator (.ne.) + ! IEEE_FMA + interface ieee_fma + module procedure fma04 + module procedure fma08 +#ifdef HAVE_GFC_REAL_10 + module procedure fma10 +#endif +#ifdef HAVE_GFC_REAL_16 + module procedure fma16 +#endif + end interface ieee_fma ! IEEE_IS_FINITE @@ -808,6 +819,65 @@ SUPPORTGENERIC(IEEE_SUPPORT_STANDARD) contains + impure elemental function fma04(x, y, z) + use iso_c_binding, only : knd =3D> c_float + real(4) fma04 + real(4), intent(in) :: x, y, z + interface + function fmaf(x, y, z) bind(c, name=3D'fmaf') + import knd + real(knd) fmaf + real(knd), intent(in), value :: x, y, z + end function fmaf + end interface + fma04 =3D fmaf(real(x, knd), real(y, knd), real(z, knd)) + end function fma04 + + impure elemental function fma08(x, y, z) + use iso_c_binding, only : knd =3D> c_double + real(8) fma08 + real(8), intent(in) :: x, y, z + interface + function fma(x, y, z) bind(c, name=3D'fma') + import knd + real(knd) fma + real(knd), intent(in), value :: x, y, z + end function fma + end interface + fma08 =3D fma(real(x, knd), real(y, knd), real(z, knd)) + end function fma08 +#ifdef HAVE_GFC_REAL_10 + impure elemental function fma10(x, y, z) + use iso_c_binding, only : knd =3D> c_long_double + real(10) fma10 + real(10), intent(in) :: x, y, z + interface + function fmal(x, y, z) bind(c, name=3D'fmal') + import knd + real(knd) fmal + real(knd), intent(in), value :: x, y, z + end function fmal + end interface + fma10 =3D fmal(real(x, knd), real(y, knd), real(z, knd)) + end function fma10 +#endif +#ifdef HAVE_GFC_REAL_16 + impure elemental function fma16(x, y, z) + integer, parameter :: knd =3D 16 + real(16) fma16 + real(16), intent(in) :: x, y, z + interface + function fmaq(x, y, z) bind(c, name=3D'fmaq') + import knd + real(knd) fmaq + real(knd), intent(in) :: x, y, z + end function fmaq + end interface + fma16 =3D fmaq(real(x, knd), real(y, knd), real(z, knd)) + end function fma16 +#endif + + ! Equality operators for IEEE_CLASS_TYPE and IEEE_ROUNDING_MODE elemental logical function IEEE_CLASS_TYPE_EQ (X, Y) result(res) implicit none=