flang/lib/Evaluate/host.cpp

   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