flang/module/__fortran_ieee_exceptions.f90

   1 !===-- module/__fortran_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 ! The content of the standard intrinsic IEEE_EXCEPTIONS module is packaged
  11 ! here under another name so that IEEE_ARITHMETIC can USE it and export its
  12 ! declarations without clashing with a non-intrinsic module in a program.
  13
  14 #include '../include/flang/Runtime/magic-numbers.h'
  15
  16 module __fortran_ieee_exceptions
  17   use __fortran_builtins, only: &
  18     ieee_flag_type => __builtin_ieee_flag_type, &
  19     ieee_support_flag => __builtin_ieee_support_flag, &
  20     ieee_support_halting => __builtin_ieee_support_halting, &
  21     ieee_invalid => __builtin_ieee_invalid, &
  22     ieee_overflow => __builtin_ieee_overflow, &
  23     ieee_divide_by_zero => __builtin_ieee_divide_by_zero, &
  24     ieee_underflow => __builtin_ieee_underflow, &
  25     ieee_inexact => __builtin_ieee_inexact, &
  26     ieee_denorm => __builtin_ieee_denorm
  27   implicit none
  28   private
  29
  30   public :: ieee_flag_type, ieee_support_flag, ieee_support_halting
  31   public :: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_underflow, &
  32             ieee_inexact, ieee_denorm
  33
  34   type(ieee_flag_type), parameter, public :: &
  35     ieee_usual(*) = [ ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
  36     ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ]
  37
  38   type, public :: ieee_modes_type ! Fortran 2018, 17.7
  39     private ! opaque fenv.h femode_t data
  40     integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT)
  41   end type ieee_modes_type
  42
  43   type, public :: ieee_status_type ! Fortran 2018, 17.7
  44     private ! opaque fenv.h fenv_t data
  45     integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT)
  46   end type ieee_status_type
  47
  48 ! Define specifics with 1 LOGICAL or REAL argument for generic G.
  49 #define SPECIFICS_L(G) \
  50   G(1) G(2) G(4) G(8)
  51 #if __x86_64__
  52 #define SPECIFICS_R(G) \
  53   G(2) G(3) G(4) G(8) G(10) G(16)
  54 #else
  55 #define SPECIFICS_R(G) \
  56   G(2) G(3) G(4) G(8) G(16)
  57 #endif
  58
  59 #define IEEE_GET_FLAG_L(FVKIND) \
  60   elemental subroutine ieee_get_flag_l##FVKIND(flag, flag_value); \
  61     import ieee_flag_type; \
  62     type(ieee_flag_type), intent(in) :: flag; \
  63     logical(FVKIND), intent(out) :: flag_value; \
  64   end subroutine ieee_get_flag_l##FVKIND;
  65   interface ieee_get_flag
  66     SPECIFICS_L(IEEE_GET_FLAG_L)
  67   end interface ieee_get_flag
  68   public :: ieee_get_flag
  69 #undef IEEE_GET_FLAG_L
  70
  71 #define IEEE_GET_HALTING_MODE_L(HKIND) \
  72   elemental subroutine ieee_get_halting_mode_l##HKIND(flag, halting); \
  73     import ieee_flag_type; \
  74     type(ieee_flag_type), intent(in) :: flag; \
  75     logical(HKIND), intent(out) :: halting; \
  76   end subroutine ieee_get_halting_mode_l##HKIND;
  77   interface ieee_get_halting_mode
  78     SPECIFICS_L(IEEE_GET_HALTING_MODE_L)
  79   end interface ieee_get_halting_mode
  80   public :: ieee_get_halting_mode
  81 #undef IEEE_GET_HALTING_MODE_L
  82
  83   interface ieee_get_modes
  84     pure subroutine ieee_get_modes_0(modes)
  85       import ieee_modes_type
  86       type(ieee_modes_type), intent(out) :: modes
  87     end subroutine ieee_get_modes_0
  88   end interface
  89   public :: ieee_get_modes
  90
  91   interface ieee_get_status
  92     pure subroutine ieee_get_status_0(status)
  93       import ieee_status_type
  94       type(ieee_status_type), intent(out) :: status
  95     end subroutine ieee_get_status_0
  96   end interface
  97   public :: ieee_get_status
  98
  99 #define IEEE_SET_FLAG_L(FVKIND) \
 100   elemental subroutine ieee_set_flag_l##FVKIND(flag, flag_value); \
 101     import ieee_flag_type; \
 102     type(ieee_flag_type), intent(in) :: flag; \
 103     logical(FVKIND), intent(in) :: flag_value; \
 104   end subroutine ieee_set_flag_l##FVKIND;
 105   interface ieee_set_flag
 106     SPECIFICS_L(IEEE_SET_FLAG_L)
 107   end interface ieee_set_flag
 108   public :: ieee_set_flag
 109 #undef IEEE_SET_FLAG_L
 110
 111 #define IEEE_SET_HALTING_MODE_L(HKIND) \
 112   elemental subroutine ieee_set_halting_mode_l##HKIND(flag, halting); \
 113     import ieee_flag_type; \
 114     type(ieee_flag_type), intent(in) :: flag; \
 115     logical(HKIND), intent(in) :: halting; \
 116   end subroutine ieee_set_halting_mode_l##HKIND;
 117   interface ieee_set_halting_mode
 118     SPECIFICS_L(IEEE_SET_HALTING_MODE_L)
 119   end interface ieee_set_halting_mode
 120   public :: ieee_set_halting_mode
 121 #undef IEEE_SET_HALTING_MODE_L
 122
 123   interface ieee_set_modes
 124     subroutine ieee_set_modes_0(modes)
 125       import ieee_modes_type
 126       type(ieee_modes_type), intent(in) :: modes
 127     end subroutine ieee_set_modes_0
 128   end interface
 129   public :: ieee_set_modes
 130
 131   interface ieee_set_status
 132     pure subroutine ieee_set_status_0(status)
 133       import ieee_status_type
 134       type(ieee_status_type), intent(in) :: status
 135     end subroutine ieee_set_status_0
 136   end interface
 137   public :: ieee_set_status
 138
 139 end module __fortran_ieee_exceptions