1 //===-- lib/Evaluate/host.cpp ---------------------------------------------===//
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 #include "host.h"
10
11 #include "flang/Common/idioms.h"
12 #include "llvm/Support/Errno.h"
13 #include <cfenv>
14 #if __x86_64__
15 #include <xmmintrin.h>
16 #endif
17
18 namespace Fortran::evaluate::host {
19 using namespace Fortran::parser::literals;
20
SetUpHostFloatingPointEnvironment(FoldingContext & context)21 void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
22 FoldingContext &context) {
23 errno = 0;
24 std::fenv_t currentFenv;
25 if (feholdexcept(&originalFenv_) != 0) {
26 common::die("Folding with host runtime: feholdexcept() failed: %s",
27 llvm::sys::StrError(errno).c_str());
28 return;
29 }
30 if (fegetenv(¤tFenv) != 0) {
31 common::die("Folding with host runtime: fegetenv() failed: %s",
32 llvm::sys::StrError(errno).c_str());
33 return;
34 }
35 #if __x86_64__
36 hasSubnormalFlushingHardwareControl_ = true;
37 originalMxcsr = _mm_getcsr();
38 unsigned int currentMxcsr{originalMxcsr};
39 if (context.flushSubnormalsToZero()) {
40 currentMxcsr |= 0x8000;
41 currentMxcsr |= 0x0040;
42 } else {
43 currentMxcsr &= ~0x8000;
44 currentMxcsr &= ~0x0040;
45 }
46 #elif defined(__aarch64__)
47 #if defined(__GNU_LIBRARY__)
48 hasSubnormalFlushingHardwareControl_ = true;
49 if (context.flushSubnormalsToZero()) {
50 currentFenv.__fpcr |= (1U << 24); // control register
51 } else {
52 currentFenv.__fpcr &= ~(1U << 24); // control register
53 }
54 #elif defined(__BIONIC__)
55 hasSubnormalFlushingHardwareControl_ = true;
56 if (context.flushSubnormalsToZero()) {
57 currentFenv.__control |= (1U << 24); // control register
58 } else {
59 currentFenv.__control &= ~(1U << 24); // control register
60 }
61 #else
62 // If F18 is built with other C libraries on AArch64, software flushing will
63 // be performed around host library calls if subnormal flushing is requested
64 #endif
65 #else
66 // If F18 is not built on one of the above host architecture, software
67 // flushing will be performed around host library calls if needed.
68 #endif
69
70 #ifdef __clang__
71 // clang does not ensure that floating point environment flags are meaningful.
72 // It may perform optimizations that will impact the floating point
73 // environment. For instance, libc++ complex float tan and tanh compilation
74 // with clang -O2 introduces a division by zero on X86 in unused slots of xmm
75 // registers. Therefore, fetestexcept should not be used.
76 hardwareFlagsAreReliable_ = false;
77 #endif
78 errno = 0;
79 if (fesetenv(¤tFenv) != 0) {
80 common::die("Folding with host runtime: fesetenv() failed: %s",
81 llvm::sys::StrError(errno).c_str());
82 return;
83 }
84 #if __x86_64__
85 _mm_setcsr(currentMxcsr);
86 #endif
87
88 switch (context.rounding().mode) {
89 case common::RoundingMode::TiesToEven:
90 fesetround(FE_TONEAREST);
91 break;
92 case common::RoundingMode::ToZero:
93 fesetround(FE_TOWARDZERO);
94 break;
95 case common::RoundingMode::Up:
96 fesetround(FE_UPWARD);
97 break;
98 case common::RoundingMode::Down:
99 fesetround(FE_DOWNWARD);
100 break;
101 case common::RoundingMode::TiesAwayFromZero:
102 fesetround(FE_TONEAREST);
103 context.messages().Say(
104 "TiesAwayFromZero rounding mode is not available when folding constants"
105 " with host runtime; using TiesToEven instead"_en_US);
106 break;
107 }
108 flags_.clear();
109 errno = 0;
110 }
CheckAndRestoreFloatingPointEnvironment(FoldingContext & context)111 void HostFloatingPointEnvironment::CheckAndRestoreFloatingPointEnvironment(
112 FoldingContext &context) {
113 int errnoCapture{errno};
114 if (hardwareFlagsAreReliable()) {
115 int exceptions{fetestexcept(FE_ALL_EXCEPT)};
116 if (exceptions & FE_INVALID) {
117 flags_.set(RealFlag::InvalidArgument);
118 }
119 if (exceptions & FE_DIVBYZERO) {
120 flags_.set(RealFlag::DivideByZero);
121 }
122 if (exceptions & FE_OVERFLOW) {
123 flags_.set(RealFlag::Overflow);
124 }
125 if (exceptions & FE_UNDERFLOW) {
126 flags_.set(RealFlag::Underflow);
127 }
128 if (exceptions & FE_INEXACT) {
129 flags_.set(RealFlag::Inexact);
130 }
131 }
132
133 if (flags_.empty()) {
134 if (errnoCapture == EDOM) {
135 flags_.set(RealFlag::InvalidArgument);
136 }
137 if (errnoCapture == ERANGE) {
138 // can't distinguish over/underflow from errno
139 flags_.set(RealFlag::Overflow);
140 }
141 }
142
143 if (!flags_.empty()) {
144 RealFlagWarnings(context, flags_, "intrinsic function");
145 }
146 errno = 0;
147 if (fesetenv(&originalFenv_) != 0) {
148 std::fprintf(
149 stderr, "fesetenv() failed: %s\n", llvm::sys::StrError(errno).c_str());
150 common::die(
151 "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
152 llvm::sys::StrError(errno).c_str());
153 }
154 #if __x86_64__
155 _mm_setcsr(originalMxcsr);
156 #endif
157
158 errno = 0;
159 }
160 } // namespace Fortran::evaluate::host
161