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