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
18namespace Fortran::evaluate::host {
19using namespace Fortran::parser::literals;
20
21void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
22 FoldingContext &context) {
23 errno = 0;
24 std::fenv_t currentFenv;
25 if (feholdexcept(envp: &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(envp: &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(envp: &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(i: 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}
115void 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(envp: &originalFenv_) != 0) {
153 std::fprintf(
154 stderr, format: "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(i: originalMxcsr);
161#endif
162
163 errno = 0;
164}
165} // namespace Fortran::evaluate::host
166

source code of flang/lib/Evaluate/host.cpp