|
173
|
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(¤tFenv_) != 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(¤tFenv_) != 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
|
