diff options
author | Francois-Xavier Coudert <fxcoudert@gmail.com> | 2022-09-04 18:24:23 +0200 |
---|---|---|
committer | Francois-Xavier Coudert <fxcoudert@gmail.com> | 2022-09-19 14:26:34 +0200 |
commit | de40fab2f32b03c3d8f69f72c7f1e38694f93d35 (patch) | |
tree | a5100ce2c023af13b9659f48592b3719b2577612 /libgfortran | |
parent | 6efc494a24bb423f1f9ef8dbdc65ca189072eb8d (diff) | |
download | gcc-de40fab2f32b03c3d8f69f72c7f1e38694f93d35.zip gcc-de40fab2f32b03c3d8f69f72c7f1e38694f93d35.tar.gz gcc-de40fab2f32b03c3d8f69f72c7f1e38694f93d35.tar.bz2 |
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 <fxcoudert@gcc.gnu.org>
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.
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/ieee/ieee_arithmetic.F90 | 3 | ||||
-rw-r--r-- | libgfortran/ieee/ieee_exceptions.F90 | 63 |
2 files changed, 65 insertions, 1 deletions
diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 7dce37a..ce30e4a 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 77363cf..3ed2f6e 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) |