From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1665) id 372B83858401; Mon, 19 Sep 2022 12:27:13 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 372B83858401 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1663590433; bh=5vnB6O9bJYTSGUUsMMc08uW9QRoHfoL8+CJtQDQZs9c=; h=From:To:Subject:Date:From; b=yZVNK8uC7CX8eIXwQt0KvDzR5KYIzWlN8/L46IZoMF9sDYaFs8R9t9rV1rvwzZV/s rR48XJYdRy/hkRyeDTiz9Csq2U/HA55aPCiMC0oknb6ZH3N4ECJDF1wGy/xIsNKeLz +Q7ZPVXsjXPyGI2/E6EqKH/Taf8hsaFUcXuNyXXk= 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-2722] Fortran: add IEEE_MODES_TYPE, IEEE_GET_MODES and IEEE_SET_MODES X-Act-Checkin: gcc X-Git-Author: Francois-Xavier Coudert X-Git-Refname: refs/heads/master X-Git-Oldrev: 6efc494a24bb423f1f9ef8dbdc65ca189072eb8d X-Git-Newrev: de40fab2f32b03c3d8f69f72c7f1e38694f93d35 Message-Id: <20220919122713.372B83858401@sourceware.org> Date: Mon, 19 Sep 2022 12:27:13 +0000 (GMT) List-Id: https://gcc.gnu.org/g:de40fab2f32b03c3d8f69f72c7f1e38694f93d35 commit r13-2722-gde40fab2f32b03c3d8f69f72c7f1e38694f93d35 Author: Francois-Xavier Coudert Date: Sun Sep 4 18:24:23 2022 +0200 Fortran: add IEEE_MODES_TYPE, IEEE_GET_MODES and IEEE_SET_MODES The IEEE_MODES_TYPE type and the two functions that get and set it were added in Fortran 2018. They can be implemented using the already existing target-specific functions. A future optimization could, on some targets, set/get all modes through one or two instructions only, but that would need a new set of functions in all config/fpu-* files. 2022-09-04 Francois-Xavier Coudert libgfortran/ * ieee/ieee_exceptions.F90: Add IEEE_MODES_TYPE, IEEE_GET_MODES and IEEE_SET_MODES. * ieee/ieee_arithmetic.F90: Make them public in IEEE_ARITHMETIC as well. gcc/testsuite/ * gfortran.dg/ieee/modes_1.f90: New test. Diff: --- gcc/testsuite/gfortran.dg/ieee/modes_1.f90 | 95 ++++++++++++++++++++++++++++++ libgfortran/ieee/ieee_arithmetic.F90 | 3 +- libgfortran/ieee/ieee_exceptions.F90 | 63 ++++++++++++++++++++ 3 files changed, 160 insertions(+), 1 deletion(-) diff --git a/gcc/testsuite/gfortran.dg/ieee/modes_1.f90 b/gcc/testsuite/gfortran.dg/ieee/modes_1.f90 new file mode 100644 index 00000000000..b6ab28847f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/modes_1.f90 @@ -0,0 +1,95 @@ +! { dg-do run } +! +! Test IEEE_MODES_TYPE, IEEE_GET_MODES and IEEE_SET_MODES + + +! The symbols should be accessible from both IEEE_EXCEPTIONS +! and IEEE_ARITHMETIC. + +subroutine test_1 + use ieee_exceptions, only : IEEE_GET_MODES, IEEE_SET_MODES +end subroutine + +subroutine test_2 + use ieee_arithmetic, only : IEEE_GET_MODES, IEEE_SET_MODES +end subroutine + +subroutine test_3 + use ieee_exceptions, only : IEEE_MODES_TYPE +end subroutine + +subroutine test_4 + use ieee_arithmetic, only : IEEE_MODES_TYPE +end subroutine + + +! Check that the functions actually do the job + +program foo + use ieee_arithmetic + implicit none + + type(ieee_modes_type) :: modes1, modes2 + type(ieee_round_type) :: rmode + logical :: f + + ! Set some modes + if (ieee_support_underflow_control()) then + call ieee_set_underflow_mode(gradual=.false.) + endif + if (ieee_support_rounding(ieee_up)) then + call ieee_set_rounding_mode(ieee_up) + endif + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, .true.) + endif + + call ieee_get_modes(modes1) + + ! Change modes + if (ieee_support_underflow_control()) then + call ieee_set_underflow_mode(gradual=.true.) + endif + if (ieee_support_rounding(ieee_down)) then + call ieee_set_rounding_mode(ieee_down) + endif + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, .false.) + endif + + ! Save and restore the previous modes + call ieee_get_modes(modes2) + call ieee_set_modes(modes1) + + ! Check them + if (ieee_support_underflow_control()) then + call ieee_get_underflow_mode(f) + if (f) stop 1 + endif + if (ieee_support_rounding(ieee_down)) then + call ieee_get_rounding_mode(rmode) + if (rmode /= ieee_up) stop 2 + endif + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, f) + if (.not. f) stop 3 + endif + + ! Restore the second set of modes + call ieee_set_modes(modes2) + + ! Check again + if (ieee_support_underflow_control()) then + call ieee_get_underflow_mode(f) + if (.not. f) stop 3 + endif + if (ieee_support_rounding(ieee_down)) then + call ieee_get_rounding_mode(rmode) + if (rmode /= ieee_down) stop 4 + endif + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, f) + if (f) stop 5 + endif + +end program foo diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 7dce37a5099..ce30e4afca3 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -39,7 +39,8 @@ 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_MODES_TYPE, IEEE_GET_MODES, IEEE_SET_MODES ! Derived types and named constants diff --git a/libgfortran/ieee/ieee_exceptions.F90 b/libgfortran/ieee/ieee_exceptions.F90 index 77363cfe342..3ed2f6e3e2c 100644 --- a/libgfortran/ieee/ieee_exceptions.F90 +++ b/libgfortran/ieee/ieee_exceptions.F90 @@ -56,6 +56,13 @@ module IEEE_EXCEPTIONS character(len=GFC_FPE_STATE_BUFFER_SIZE) :: hidden end type + type, public :: IEEE_MODES_TYPE + private + integer :: rounding + integer :: underflow + integer :: halting + end type + interface IEEE_SUPPORT_FLAG module procedure IEEE_SUPPORT_FLAG_4, & IEEE_SUPPORT_FLAG_8, & @@ -72,9 +79,65 @@ module IEEE_EXCEPTIONS public :: IEEE_SET_HALTING_MODE, IEEE_GET_HALTING_MODE public :: IEEE_SET_FLAG, IEEE_GET_FLAG public :: IEEE_SET_STATUS, IEEE_GET_STATUS + public :: IEEE_SET_MODES, IEEE_GET_MODES contains +! Fortran 2018: Saving and restoring floating-point modes +! (rounding modes, underflow mode, and halting mode) +! +! For now, we only have one rounding mode for all kinds. +! Some targets could optimize getting/setting all modes at once, but for now +! we make three calls. This code must be kept in sync with: +! - IEEE_{GET,SET}_ROUNDING_MODE +! - IEEE_{GET,SET}_UNDERFLOW_MODE +! - IEEE_{GET,SET}_HALTING_MODE + + subroutine IEEE_GET_MODES (MODES) + implicit none + type(IEEE_MODES_TYPE), intent(out) :: MODES + + interface + integer function helper_rounding() & + bind(c, name="_gfortrani_get_fpu_rounding_mode") + end function + integer function helper_underflow() & + bind(c, name="_gfortrani_get_fpu_underflow_mode") + end function + pure integer function helper_halting() & + bind(c, name="_gfortrani_get_fpu_trap_exceptions") + end function + end interface + + MODES%rounding = helper_rounding() + MODES%underflow = helper_underflow() + MODES%halting = helper_halting() + end subroutine + + subroutine IEEE_SET_MODES (MODES) + implicit none + type(IEEE_MODES_TYPE), intent(in) :: MODES + + interface + subroutine helper_rounding(val) & + bind(c, name="_gfortrani_set_fpu_rounding_mode") + integer, value :: val + end subroutine + subroutine helper_underflow(val) & + bind(c, name="_gfortrani_set_fpu_underflow_mode") + integer, value :: val + end subroutine + pure subroutine helper_halting(trap, notrap) & + bind(c, name="_gfortrani_set_fpu_trap_exceptions") + integer, intent(in), value :: trap, notrap + end subroutine + end interface + + call helper_rounding(MODES%rounding) + call helper_underflow(MODES%underflow) + call helper_halting(MODES%halting, NOT(MODES%halting)) + end subroutine + ! Saving and restoring floating-point status subroutine IEEE_GET_STATUS (STATUS_VALUE)