flang/module/ieee_exceptions.f90

   1 !===-- module/ieee_exceptions.f90 ------------------------------------------===!
   2 !
   3 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 ! See https://llvm.org/LICENSE.txt for license information.
   5 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 !
   7 !===------------------------------------------------------------------------===!
   8
   9 ! See Fortran 2018, clause 17
  10 module ieee_exceptions
  11
  12   type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3
  13     private
  14     integer(kind=1) :: flag = 0
  15   end type ieee_flag_type
  16
  17   type(ieee_flag_type), parameter :: &
  18     ieee_invalid = ieee_flag_type(1), &
  19     ieee_overflow = ieee_flag_type(2), &
  20     ieee_divide_by_zero = ieee_flag_type(4), &
  21     ieee_underflow = ieee_flag_type(8), &
  22     ieee_inexact = ieee_flag_type(16), &
  23     ieee_denorm = ieee_flag_type(32) ! PGI extension
  24
  25   type(ieee_flag_type), parameter :: &
  26     ieee_usual(*) = [ &
  27       ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
  28     ieee_all(*) = [ &
  29       ieee_usual, ieee_underflow, ieee_inexact, ieee_denorm ]
  30
  31   type :: ieee_modes_type ! Fortran 2018, 17.7
  32     private
  33   end type ieee_modes_type
  34
  35   type :: ieee_status_type ! Fortran 2018, 17.7
  36     private
  37   end type ieee_status_type
  38
  39   private :: ieee_support_flag_2, ieee_support_flag_3, &
  40       ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
  41       ieee_support_flag_16
  42   interface ieee_support_flag
  43     module procedure :: ieee_support_flag, &
  44       ieee_support_flag_2, ieee_support_flag_3, &
  45       ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
  46       ieee_support_flag_16
  47   end interface
  48
  49  contains
  50   elemental subroutine ieee_get_flag(flag, flag_value)
  51     type(ieee_flag_type), intent(in) :: flag
  52     logical, intent(out) :: flag_value
  53   end subroutine ieee_get_flag
  54
  55   elemental subroutine ieee_get_halting_mode(flag, halting)
  56     type(ieee_flag_type), intent(in) :: flag
  57     logical, intent(out) :: halting
  58   end subroutine ieee_get_halting_mode
  59
  60   subroutine ieee_get_modes(modes)
  61     type(ieee_modes_type), intent(out) :: modes
  62   end subroutine ieee_get_modes
  63
  64   subroutine ieee_get_status(status)
  65     type(ieee_status_type), intent(out) :: status
  66   end subroutine ieee_get_status
  67
  68   pure subroutine ieee_set_flag(flag, flag_value)
  69     type(ieee_flag_type), intent(in) :: flag
  70     logical, intent(in) :: flag_value
  71   end subroutine ieee_set_flag
  72
  73   pure subroutine ieee_set_halting_mode(flag, halting)
  74     type(ieee_flag_type), intent(in) :: flag
  75     logical, intent(in) :: halting
  76   end subroutine ieee_set_halting_mode
  77
  78   subroutine ieee_set_modes(modes)
  79     type(ieee_modes_type), intent(in) :: modes
  80   end subroutine ieee_set_modes
  81
  82   subroutine ieee_set_status(status)
  83     type(ieee_status_type), intent(in) :: status
  84   end subroutine ieee_set_status
  85
  86   pure logical function ieee_support_flag(flag)
  87     type(ieee_flag_type), intent(in) :: flag
  88     ieee_support_flag = .true.
  89   end function
  90   pure logical function ieee_support_flag_2(flag, x)
  91     type(ieee_flag_type), intent(in) :: flag
  92     real(kind=2), intent(in) :: x(..)
  93     ieee_support_flag_2 = .true.
  94   end function
  95   pure logical function ieee_support_flag_3(flag, x)
  96     type(ieee_flag_type), intent(in) :: flag
  97     real(kind=3), intent(in) :: x(..)
  98     ieee_support_flag_3 = .true.
  99   end function
 100   pure logical function ieee_support_flag_4(flag, x)
 101     type(ieee_flag_type), intent(in) :: flag
 102     real(kind=4), intent(in) :: x(..)
 103     ieee_support_flag_4 = .true.
 104   end function
 105   pure logical function ieee_support_flag_8(flag, x)
 106     type(ieee_flag_type), intent(in) :: flag
 107     real(kind=8), intent(in) :: x(..)
 108     ieee_support_flag_8 = .true.
 109   end function
 110   pure logical function ieee_support_flag_10(flag, x)
 111     type(ieee_flag_type), intent(in) :: flag
 112     real(kind=10), intent(in) :: x(..)
 113     ieee_support_flag_10 = .true.
 114   end function
 115   pure logical function ieee_support_flag_16(flag, x)
 116     type(ieee_flag_type), intent(in) :: flag
 117     real(kind=16), intent(in) :: x(..)
 118     ieee_support_flag_16 = .true.
 119   end function
 120
 121   pure logical function ieee_support_halting(flag)
 122     type(ieee_flag_type), intent(in) :: flag
 123   end function ieee_support_halting
 124
 125 end module ieee_exceptions