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 context.messages().Say(
104 "TiesAwayFromZero rounding mode is not available when folding constants"
105 " with host runtime; using TiesToEven instead"_warn_en_US);
106 break;
107 }
108 flags_.clear();
109 errno = 0;
110}
111void 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(
145 context, flags_, "evaluation of intrinsic function or operation");
146 }
147 errno = 0;
148 if (fesetenv(envp: &originalFenv_) != 0) {
149 std::fprintf(
150 stderr, format: "fesetenv() failed: %s\n", llvm::sys::StrError(errno).c_str());
151 common::die(
152 "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
153 llvm::sys::StrError(errno).c_str());
154 }
155#if __x86_64__
156 _mm_setcsr(i: originalMxcsr);
157#endif
158
159 errno = 0;
160}
161} // namespace Fortran::evaluate::host
162

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