1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
!===-- 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.
include '../include/flang/Runtime/magic-numbers.h'
module __fortran_ieee_exceptions
implicit none
! Set PRIVATE by default to explicitly only export what is meant
! to be exported by this MODULE.
private
type, public :: 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, public :: &
ieee_invalid = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_INVALID), &
ieee_overflow = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_OVERFLOW), &
ieee_divide_by_zero = &
ieee_flag_type(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO), &
ieee_underflow = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_UNDERFLOW), &
ieee_inexact = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_INEXACT), &
ieee_denorm = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_DENORM) ! extension
type(ieee_flag_type), parameter, public :: &
ieee_usual(*) = [ ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ]
type, public :: ieee_modes_type ! Fortran 2018, 17.7
private ! opaque fenv.h femode_t data
integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT)
end type ieee_modes_type
type, public :: ieee_status_type ! Fortran 2018, 17.7
private ! opaque fenv.h fenv_t data
integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT)
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)
#if __x86_64__
#define SPECIFICS_R(G) \
G(2) G(3) G(4) G(8) G(10) G(16)
#else
#define SPECIFICS_R(G) \
G(2) G(3) G(4) G(8) G(16)
#endif
#define IEEE_GET_FLAG_L(FVKIND) \
elemental subroutine ieee_get_flag_l##FVKIND(flag, flag_value); \
import ieee_flag_type; \
type(ieee_flag_type), intent(in) :: flag; \
logical(FVKIND), intent(out) :: flag_value; \
end subroutine ieee_get_flag_l##FVKIND;
interface ieee_get_flag
SPECIFICS_L(IEEE_GET_FLAG_L)
end interface ieee_get_flag
public :: ieee_get_flag
#undef IEEE_GET_FLAG_L
#define IEEE_GET_HALTING_MODE_L(HKIND) \
elemental subroutine ieee_get_halting_mode_l##HKIND(flag, halting); \
import ieee_flag_type; \
type(ieee_flag_type), intent(in) :: flag; \
logical(HKIND), intent(out) :: halting; \
end subroutine ieee_get_halting_mode_l##HKIND;
interface ieee_get_halting_mode
SPECIFICS_L(IEEE_GET_HALTING_MODE_L)
end interface ieee_get_halting_mode
public :: ieee_get_halting_mode
#undef IEEE_GET_HALTING_MODE_L
interface ieee_get_modes
pure subroutine ieee_get_modes_0(modes)
import ieee_modes_type
type(ieee_modes_type), intent(out) :: modes
end subroutine ieee_get_modes_0
end interface
public :: ieee_get_modes
interface ieee_get_status
pure subroutine ieee_get_status_0(status)
import ieee_status_type
type(ieee_status_type), intent(out) :: status
end subroutine ieee_get_status_0
end interface
public :: ieee_get_status
#define IEEE_SET_FLAG_L(FVKIND) \
elemental 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
public :: ieee_set_flag
#undef IEEE_SET_FLAG_L
#define IEEE_SET_HALTING_MODE_L(HKIND) \
elemental 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
public :: ieee_set_halting_mode
#undef IEEE_SET_HALTING_MODE_L
interface ieee_set_modes
subroutine ieee_set_modes_0(modes)
import ieee_modes_type
type(ieee_modes_type), intent(in) :: modes
end subroutine ieee_set_modes_0
end interface
public :: ieee_set_modes
interface ieee_set_status
subroutine ieee_set_status_0(status)
import ieee_status_type
type(ieee_status_type), intent(in) :: status
end subroutine ieee_set_status_0
end interface
public :: ieee_set_status
#define IEEE_SUPPORT_FLAG_R(XKIND) \
pure 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
pure logical function ieee_support_flag_0(flag)
import ieee_flag_type
type(ieee_flag_type), intent(in) :: flag
end function ieee_support_flag_0
SPECIFICS_R(IEEE_SUPPORT_FLAG_R)
end interface ieee_support_flag
public :: ieee_support_flag
#undef IEEE_SUPPORT_FLAG_R
interface ieee_support_halting
pure logical function ieee_support_halting_0(flag)
import ieee_flag_type
type(ieee_flag_type), intent(in) :: flag
end function ieee_support_halting_0
end interface
public :: ieee_support_halting
end module __fortran_ieee_exceptions
|
