mirror of
https://github.com/intel/llvm.git
synced 2026-01-22 23:49:22 +08:00
949c39efb1
The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
150 lines
4.7 KiB
Fortran
150 lines
4.7 KiB
Fortran
!===-- module/__fortran_ieee_exceptions.f90 --------------------------------===!
|
|
!
|
|
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
! See https://llvm.org/LICENSE.txt for license information.
|
|
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
!
|
|
!===------------------------------------------------------------------------===!
|
|
|
|
! See Fortran 2018, clause 17
|
|
! The content of the standard intrinsic IEEE_EXCEPTIONS module is packaged
|
|
! here under another name so that IEEE_ARITHMETIC can USE it and export its
|
|
! declarations without clashing with a non-intrinsic module in a program.
|
|
|
|
module __Fortran_ieee_exceptions
|
|
|
|
type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3
|
|
private
|
|
integer(kind=1) :: flag = 0
|
|
end type ieee_flag_type
|
|
|
|
type(ieee_flag_type), parameter :: &
|
|
ieee_invalid = ieee_flag_type(1), &
|
|
ieee_overflow = ieee_flag_type(2), &
|
|
ieee_divide_by_zero = ieee_flag_type(4), &
|
|
ieee_underflow = ieee_flag_type(8), &
|
|
ieee_inexact = ieee_flag_type(16), &
|
|
ieee_denorm = ieee_flag_type(32) ! PGI extension
|
|
|
|
type(ieee_flag_type), parameter :: &
|
|
ieee_usual(*) = [ &
|
|
ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
|
|
ieee_all(*) = [ &
|
|
ieee_usual, ieee_underflow, ieee_inexact, ieee_denorm ]
|
|
|
|
type :: ieee_modes_type ! Fortran 2018, 17.7
|
|
private
|
|
end type ieee_modes_type
|
|
|
|
type :: ieee_status_type ! Fortran 2018, 17.7
|
|
private
|
|
end type ieee_status_type
|
|
|
|
! Define specifics with 1 LOGICAL or REAL argument for generic G.
|
|
#define SPECIFICS_L(G) \
|
|
G(1) G(2) G(4) G(8)
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8) G(10) G(16)
|
|
|
|
! Set PRIVATE accessibility for specifics with 1 LOGICAL or REAL argument for
|
|
! generic G.
|
|
#define PRIVATE_L(G) private :: \
|
|
G##_l1, G##_l2, G##_l4, G##_l8
|
|
#define PRIVATE_R(G) private :: \
|
|
G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16
|
|
|
|
interface
|
|
elemental subroutine ieee_get_flag(flag, flag_value)
|
|
import ieee_flag_type
|
|
type(ieee_flag_type), intent(in) :: flag
|
|
logical, intent(out) :: flag_value
|
|
end subroutine ieee_get_flag
|
|
end interface
|
|
|
|
interface
|
|
elemental subroutine ieee_get_halting_mode(flag, halting)
|
|
import ieee_flag_type
|
|
type(ieee_flag_type), intent(in) :: flag
|
|
logical, intent(out) :: halting
|
|
end subroutine ieee_get_halting_mode
|
|
end interface
|
|
|
|
interface
|
|
subroutine ieee_get_modes(modes)
|
|
import ieee_modes_type
|
|
type(ieee_modes_type), intent(out) :: modes
|
|
end subroutine ieee_get_modes
|
|
end interface
|
|
|
|
interface
|
|
subroutine ieee_get_status(status)
|
|
import ieee_status_type
|
|
type(ieee_status_type), intent(out) :: status
|
|
end subroutine ieee_get_status
|
|
end interface
|
|
|
|
#define IEEE_SET_FLAG_L(FVKIND) \
|
|
pure subroutine ieee_set_flag_l##FVKIND(flag,flag_value); \
|
|
import ieee_flag_type; \
|
|
type(ieee_flag_type), intent(in) :: flag(..); \
|
|
logical(FVKIND), intent(in) :: flag_value(..); \
|
|
end subroutine ieee_set_flag_l##FVKIND;
|
|
interface ieee_set_flag
|
|
SPECIFICS_L(IEEE_SET_FLAG_L)
|
|
end interface ieee_set_flag
|
|
private :: ieee_set_flag_1
|
|
PRIVATE_L(IEEE_SET_FLAG)
|
|
#undef IEEE_SET_FLAG_L
|
|
|
|
#define IEEE_SET_HALTING_MODE_L(HKIND) \
|
|
pure subroutine ieee_set_halting_mode_l##HKIND(flag,halting); \
|
|
import ieee_flag_type; \
|
|
type(ieee_flag_type), intent(in) :: flag(..); \
|
|
logical(HKIND), intent(in) :: halting(..); \
|
|
end subroutine ieee_set_halting_mode_l##HKIND;
|
|
interface ieee_set_halting_mode
|
|
SPECIFICS_L(IEEE_SET_HALTING_MODE_L)
|
|
end interface ieee_set_halting_mode
|
|
private :: ieee_set_halting_mode_1
|
|
PRIVATE_L(IEEE_SET_HALTING_MODE)
|
|
#undef IEEE_SET_HALTING_MODE_L
|
|
|
|
interface
|
|
subroutine ieee_set_modes(modes)
|
|
import ieee_modes_type
|
|
type(ieee_modes_type), intent(in) :: modes
|
|
end subroutine ieee_set_modes
|
|
end interface
|
|
|
|
interface
|
|
subroutine ieee_set_status(status)
|
|
import ieee_status_type
|
|
type(ieee_status_type), intent(in) :: status
|
|
end subroutine ieee_set_status
|
|
end interface
|
|
|
|
#define IEEE_SUPPORT_FLAG_R(XKIND) \
|
|
logical function ieee_support_flag_a##XKIND(flag, x); \
|
|
import ieee_flag_type; \
|
|
type(ieee_flag_type), intent(in) :: flag; \
|
|
real(XKIND), intent(in) :: x(..); \
|
|
end function ieee_support_flag_a##XKIND;
|
|
interface ieee_support_flag
|
|
logical function ieee_support_flag(flag)
|
|
import ieee_flag_type
|
|
type(ieee_flag_type), intent(in) :: flag
|
|
end function ieee_support_flag
|
|
SPECIFICS_R(IEEE_SUPPORT_FLAG_R)
|
|
end interface ieee_support_flag
|
|
PRIVATE_R(IEEE_SUPPORT_FLAG)
|
|
#undef IEEE_SUPPORT_FLAG_R
|
|
|
|
interface
|
|
pure logical function ieee_support_halting(flag)
|
|
import ieee_flag_type
|
|
type(ieee_flag_type), intent(in) :: flag
|
|
end function ieee_support_halting
|
|
end interface
|
|
|
|
end module __Fortran_ieee_exceptions
|