From de40fab2f32b03c3d8f69f72c7f1e38694f93d35 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Sun, 4 Sep 2022 18:24:23 +0200 Subject: 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. --- libgfortran/ieee/ieee_arithmetic.F90 | 3 +- libgfortran/ieee/ieee_exceptions.F90 | 63 ++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) (limited to 'libgfortran') 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) -- cgit v1.1