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 
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(&currentFenv) != 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(&currentFenv) != 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 }
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