1//===-- lib/runtime/exceptions.cpp ------------------------------*- C++ -*-===//
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// Runtime exception support.
10
11#include "flang/Runtime/exceptions.h"
12#include "flang-rt/runtime/terminator.h"
13#include <cfenv>
14#if defined(__aarch64__) && defined(__GLIBC__)
15#include <fpu_control.h>
16#elif defined(__x86_64__) && !defined(_WIN32)
17#include <xmmintrin.h>
18#endif
19
20// File fenv.h usually, but not always, defines standard exceptions as both
21// enumerator values and preprocessor #defines. Some x86 environments also
22// define a nonstandard __FE_DENORM enumerator, but without a corresponding
23// #define, which makes it more difficult to determine if it is present or not.
24#ifndef FE_INVALID
25#define FE_INVALID 0
26#endif
27#ifndef FE_DIVBYZERO
28#define FE_DIVBYZERO 0
29#endif
30#ifndef FE_OVERFLOW
31#define FE_OVERFLOW 0
32#endif
33#ifndef FE_UNDERFLOW
34#define FE_UNDERFLOW 0
35#endif
36#ifndef FE_INEXACT
37#define FE_INEXACT 0
38#endif
39#if FE_INVALID == 1 && FE_DIVBYZERO == 4 && FE_OVERFLOW == 8 && \
40 FE_UNDERFLOW == 16 && FE_INEXACT == 32
41#define __FE_DENORM 2
42#else
43#define __FE_DENORM 0
44#endif
45
46namespace Fortran::runtime {
47
48extern "C" {
49
50// Map a set of Fortran ieee_arithmetic module exceptions to a libm fenv.h
51// excepts value.
52uint32_t RTNAME(MapException)(uint32_t excepts) {
53 Terminator terminator{__FILE__, __LINE__};
54
55 static constexpr uint32_t v{FE_INVALID};
56 static constexpr uint32_t s{__FE_DENORM};
57 static constexpr uint32_t z{FE_DIVBYZERO};
58 static constexpr uint32_t o{FE_OVERFLOW};
59 static constexpr uint32_t u{FE_UNDERFLOW};
60 static constexpr uint32_t x{FE_INEXACT};
61
62#define vm(p) p, p | v
63#define sm(p) vm(p), vm(p | s)
64#define zm(p) sm(p), sm(p | z)
65#define om(p) zm(p), zm(p | o)
66#define um(p) om(p), om(p | u)
67#define xm um(0), um(x)
68
69 static constexpr uint32_t map[]{xm};
70 static constexpr uint32_t mapSize{sizeof(map) / sizeof(uint32_t)};
71 static_assert(mapSize == 64);
72 if (excepts >= mapSize) {
73 terminator.Crash("Invalid excepts value: %d", excepts);
74 }
75 uint32_t except_value = map[excepts];
76 return except_value;
77}
78
79// The following exception processing routines have a libm call component,
80// and where available, an additional component for handling the nonstandard
81// ieee_denorm exception. The denorm component does not subsume the libm
82// component; both are needed.
83
84void RTNAME(feclearexcept)(uint32_t excepts) {
85 feclearexcept(excepts);
86#if defined(_MM_EXCEPT_DENORM)
87 _mm_setcsr(_mm_getcsr() & ~(excepts & _MM_EXCEPT_MASK));
88#endif
89}
90void RTNAME(feraiseexcept)(uint32_t excepts) {
91 feraiseexcept(excepts);
92#if defined(_MM_EXCEPT_DENORM)
93 _mm_setcsr(_mm_getcsr() | (excepts & _MM_EXCEPT_MASK));
94#endif
95}
96uint32_t RTNAME(fetestexcept)(uint32_t excepts) {
97#if defined(_MM_EXCEPT_DENORM)
98 return (_mm_getcsr() & _MM_EXCEPT_MASK & excepts) | fetestexcept(excepts);
99#else
100 return fetestexcept(excepts);
101#endif
102}
103void RTNAME(fedisableexcept)(uint32_t excepts) {
104#ifdef __USE_GNU
105 fedisableexcept(excepts);
106#endif
107#if defined(_MM_EXCEPT_DENORM)
108 _mm_setcsr(_mm_getcsr() | ((excepts & _MM_EXCEPT_MASK) << 7));
109#endif
110}
111void RTNAME(feenableexcept)(uint32_t excepts) {
112#ifdef __USE_GNU
113 feenableexcept(excepts);
114#endif
115#if defined(_MM_EXCEPT_DENORM)
116 _mm_setcsr(_mm_getcsr() & ~((excepts & _MM_EXCEPT_MASK) << 7));
117#endif
118}
119uint32_t RTNAME(fegetexcept)() {
120 uint32_t excepts = 0;
121#ifdef __USE_GNU
122 excepts = fegetexcept();
123#endif
124#if defined(_MM_EXCEPT_DENORM)
125 return (63 - ((_mm_getcsr() >> 7) & _MM_EXCEPT_MASK)) | excepts;
126#else
127 return excepts;
128#endif
129}
130
131// Check if the processor has the ability to control whether to halt or
132// continue execution when a given exception is raised.
133bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) {
134#ifdef __USE_GNU
135 except = RTNAME(MapException)(except);
136 int currentSet = RTNAME(fegetexcept)(), flipSet;
137 if (currentSet & except) {
138 RTNAME(fedisableexcept)(except);
139 flipSet = RTNAME(fegetexcept)();
140 RTNAME(feenableexcept)(except);
141 } else {
142 RTNAME(feenableexcept)(except);
143 flipSet = RTNAME(fegetexcept)();
144 RTNAME(fedisableexcept)(except);
145 }
146 return currentSet != flipSet;
147#else
148 return false;
149#endif
150}
151
152// A hardware FZ (flush to zero) bit is the negation of the
153// ieee_[get|set]_underflow_mode GRADUAL argument.
154#if defined(_MM_FLUSH_ZERO_MASK)
155// The x86_64 MXCSR FZ bit affects computations of real kinds 3, 4, and 8.
156#elif defined(_FPU_GETCW)
157// The aarch64 FPCR FZ bit affects computations of real kinds 3, 4, and 8.
158// bit 24: FZ -- single, double precision flush to zero bit
159// bit 19: FZ16 -- half precision flush to zero bit [not currently relevant]
160#define _FPU_FPCR_FZ_MASK_ 0x01080000
161#endif
162
163bool RTNAME(GetUnderflowMode)(void) {
164#if defined(_MM_FLUSH_ZERO_MASK)
165 return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF;
166#elif defined(_FPU_GETCW)
167 uint64_t fpcr;
168 _FPU_GETCW(fpcr);
169 return (fpcr & _FPU_FPCR_FZ_MASK_) == 0;
170#else
171 return false;
172#endif
173}
174void RTNAME(SetUnderflowMode)(bool flag) {
175#if defined(_MM_FLUSH_ZERO_MASK)
176 _MM_SET_FLUSH_ZERO_MODE(flag ? _MM_FLUSH_ZERO_OFF : _MM_FLUSH_ZERO_ON);
177#elif defined(_FPU_GETCW)
178 uint64_t fpcr;
179 _FPU_GETCW(fpcr);
180 if (flag) {
181 fpcr &= ~_FPU_FPCR_FZ_MASK_;
182 } else {
183 fpcr |= _FPU_FPCR_FZ_MASK_;
184 }
185 _FPU_SETCW(fpcr);
186#endif
187}
188
189size_t RTNAME(GetModesTypeSize)(void) {
190#ifdef __GLIBC_USE_IEC_60559_BFP_EXT
191 return sizeof(femode_t); // byte size of ieee_modes_type data
192#else
193 return 8; // femode_t is not defined
194#endif
195}
196size_t RTNAME(GetStatusTypeSize)(void) {
197 return sizeof(fenv_t); // byte size of ieee_status_type data
198}
199
200} // extern "C"
201} // namespace Fortran::runtime
202

source code of flang-rt/lib/runtime/exceptions.cpp