xref: /llvm-project/flang/lib/Evaluate/host.cpp (revision 0f973ac783aa100cfbce1cd2c6e8a3a8f648fae7)
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.targetCharacteristics().areSubnormalsFlushedToZero()) {
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.targetCharacteristics().areSubnormalsFlushedToZero()) {
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.targetCharacteristics().areSubnormalsFlushedToZero()) {
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.targetCharacteristics().roundingMode().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     if (context.languageFeatures().ShouldWarn(
104             common::UsageWarning::FoldingFailure)) {
105       context.messages().Say(common::UsageWarning::FoldingFailure,
106           "TiesAwayFromZero rounding mode is not available when folding "
107           "constants"
108           " with host runtime; using TiesToEven instead"_warn_en_US);
109     }
110     break;
111   }
112   flags_.clear();
113   errno = 0;
114 }
115 void HostFloatingPointEnvironment::CheckAndRestoreFloatingPointEnvironment(
116     FoldingContext &context) {
117   int errnoCapture{errno};
118   if (hardwareFlagsAreReliable()) {
119     int exceptions{fetestexcept(FE_ALL_EXCEPT)};
120     if (exceptions & FE_INVALID) {
121       flags_.set(RealFlag::InvalidArgument);
122     }
123     if (exceptions & FE_DIVBYZERO) {
124       flags_.set(RealFlag::DivideByZero);
125     }
126     if (exceptions & FE_OVERFLOW) {
127       flags_.set(RealFlag::Overflow);
128     }
129     if (exceptions & FE_UNDERFLOW) {
130       flags_.set(RealFlag::Underflow);
131     }
132     if (exceptions & FE_INEXACT) {
133       flags_.set(RealFlag::Inexact);
134     }
135   }
136 
137   if (flags_.empty()) {
138     if (errnoCapture == EDOM) {
139       flags_.set(RealFlag::InvalidArgument);
140     }
141     if (errnoCapture == ERANGE) {
142       // can't distinguish over/underflow from errno
143       flags_.set(RealFlag::Overflow);
144     }
145   }
146 
147   if (!flags_.empty()) {
148     RealFlagWarnings(
149         context, flags_, "evaluation of intrinsic function or operation");
150   }
151   errno = 0;
152   if (fesetenv(&originalFenv_) != 0) {
153     std::fprintf(
154         stderr, "fesetenv() failed: %s\n", llvm::sys::StrError(errno).c_str());
155     common::die(
156         "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
157         llvm::sys::StrError(errno).c_str());
158   }
159 #if __x86_64__
160   _mm_setcsr(originalMxcsr);
161 #endif
162 
163   errno = 0;
164 }
165 } // namespace Fortran::evaluate::host
166