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 16module __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; code will access only one component 40 integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT) 41 integer(kind=1), allocatable :: __allocatable_data(:) 42 end type ieee_modes_type 43 44 type, public :: ieee_status_type ! Fortran 2018, 17.7 45 private ! opaque fenv.h fenv_t data; code will access only one component 46 integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT) 47 integer(kind=1), allocatable :: __allocatable_data(:) 48 end type ieee_status_type 49 50! Define specifics with 1 LOGICAL or REAL argument for generic G. 51#define SPECIFICS_L(G) \ 52 G(1) G(2) G(4) G(8) 53#if __x86_64__ 54#define SPECIFICS_R(G) \ 55 G(2) G(3) G(4) G(8) G(10) G(16) 56#else 57#define SPECIFICS_R(G) \ 58 G(2) G(3) G(4) G(8) G(16) 59#endif 60 61#define IEEE_GET_FLAG_L(FVKIND) \ 62 elemental subroutine ieee_get_flag_l##FVKIND(flag, flag_value); \ 63 import ieee_flag_type; \ 64 type(ieee_flag_type), intent(in) :: flag; \ 65 logical(FVKIND), intent(out) :: flag_value; \ 66 end subroutine ieee_get_flag_l##FVKIND; 67 interface ieee_get_flag 68 SPECIFICS_L(IEEE_GET_FLAG_L) 69 end interface ieee_get_flag 70 public :: ieee_get_flag 71#undef IEEE_GET_FLAG_L 72 73#define IEEE_GET_HALTING_MODE_L(HKIND) \ 74 elemental subroutine ieee_get_halting_mode_l##HKIND(flag, halting); \ 75 import ieee_flag_type; \ 76 type(ieee_flag_type), intent(in) :: flag; \ 77 logical(HKIND), intent(out) :: halting; \ 78 end subroutine ieee_get_halting_mode_l##HKIND; 79 interface ieee_get_halting_mode 80 SPECIFICS_L(IEEE_GET_HALTING_MODE_L) 81 end interface ieee_get_halting_mode 82 public :: ieee_get_halting_mode 83#undef IEEE_GET_HALTING_MODE_L 84 85 interface ieee_get_modes 86 pure subroutine ieee_get_modes_0(modes) 87 import ieee_modes_type 88 type(ieee_modes_type), intent(out) :: modes 89 end subroutine ieee_get_modes_0 90 end interface 91 public :: ieee_get_modes 92 93 interface ieee_get_status 94 pure subroutine ieee_get_status_0(status) 95 import ieee_status_type 96 type(ieee_status_type), intent(out) :: status 97 end subroutine ieee_get_status_0 98 end interface 99 public :: ieee_get_status 100 101#define IEEE_SET_FLAG_L(FVKIND) \ 102 elemental subroutine ieee_set_flag_l##FVKIND(flag, flag_value); \ 103 import ieee_flag_type; \ 104 type(ieee_flag_type), intent(in) :: flag; \ 105 logical(FVKIND), intent(in) :: flag_value; \ 106 end subroutine ieee_set_flag_l##FVKIND; 107 interface ieee_set_flag 108 SPECIFICS_L(IEEE_SET_FLAG_L) 109 end interface ieee_set_flag 110 public :: ieee_set_flag 111#undef IEEE_SET_FLAG_L 112 113#define IEEE_SET_HALTING_MODE_L(HKIND) \ 114 elemental subroutine ieee_set_halting_mode_l##HKIND(flag, halting); \ 115 import ieee_flag_type; \ 116 type(ieee_flag_type), intent(in) :: flag; \ 117 logical(HKIND), intent(in) :: halting; \ 118 end subroutine ieee_set_halting_mode_l##HKIND; 119 interface ieee_set_halting_mode 120 SPECIFICS_L(IEEE_SET_HALTING_MODE_L) 121 end interface ieee_set_halting_mode 122 public :: ieee_set_halting_mode 123#undef IEEE_SET_HALTING_MODE_L 124 125 interface ieee_set_modes 126 subroutine ieee_set_modes_0(modes) 127 import ieee_modes_type 128 type(ieee_modes_type), intent(in) :: modes 129 end subroutine ieee_set_modes_0 130 end interface 131 public :: ieee_set_modes 132 133 interface ieee_set_status 134 pure subroutine ieee_set_status_0(status) 135 import ieee_status_type 136 type(ieee_status_type), intent(in) :: status 137 end subroutine ieee_set_status_0 138 end interface 139 public :: ieee_set_status 140 141end module __fortran_ieee_exceptions 142