decimal.cc
expression.cc
fold.cc
+ host.cc
integer.cc
intrinsics.cc
+ intrinsics-library.cc
logical.cc
real.cc
static-data.cc
tools.cc
type.cc
variable.cc
- intrinsics-library.cc
)
target_link_libraries(FortranEvaluate
--- /dev/null
+// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "host.h"
+
+#include "../common/idioms.h"
+#include <cerrno>
+#include <cfenv>
+
+namespace Fortran::evaluate::host {
+using namespace Fortran::parser::literals;
+
+void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
+ FoldingContext &context) {
+ errno = 0;
+ if (feholdexcept(&originalFenv_) != 0) {
+ common::die("Folding with host runtime: feholdexcept() failed: %s",
+ std::strerror(errno));
+ return;
+ }
+ if (fegetenv(¤tFenv_) != 0) {
+ common::die("Folding with host runtime: fegetenv() failed: %s",
+ std::strerror(errno));
+ return;
+ }
+#if __x86_64__
+ if (context.flushSubnormalsToZero()) {
+ currentFenv_.__mxcsr |= 0x8000; // result
+ currentFenv_.__mxcsr |= 0x0040; // operands
+ } else {
+ currentFenv_.__mxcsr &= ~0x8000; // result
+ currentFenv_.__mxcsr &= ~0x0040; // operands
+ }
+#else
+ // TODO other architectures
+ context.messages().Say(
+ "TODO: flushing mode for subnormals is not set for this host architecture when folding with host runtime functions"_en_US);
+#endif
+ errno = 0;
+ if (fesetenv(¤tFenv_) != 0) {
+ common::die("Folding with host runtime: fesetenv() failed: %s",
+ std::strerror(errno));
+ return;
+ }
+ switch (context.rounding().mode) {
+ case RoundingMode::TiesToEven: fesetround(FE_TONEAREST); break;
+ case RoundingMode::ToZero: fesetround(FE_TOWARDZERO); break;
+ case RoundingMode::Up: fesetround(FE_UPWARD); break;
+ case RoundingMode::Down: fesetround(FE_DOWNWARD); break;
+ case RoundingMode::TiesAwayFromZero:
+ fesetround(FE_TONEAREST);
+ context.messages().Say(
+ "TiesAwayFromZero rounding mode is not available not available when folding constants with host runtime. Using TiesToEven instead."_en_US);
+ break;
+ }
+ errno = 0;
+}
+void HostFloatingPointEnvironment::CheckAndRestoreFloatingPointEnvironment(
+ FoldingContext &context) {
+ int errnoCapture{errno};
+ int exceptions{fetestexcept(FE_ALL_EXCEPT)};
+ RealFlags flags;
+ if (exceptions & FE_INVALID) {
+ flags.set(RealFlag::InvalidArgument);
+ }
+ if (exceptions & FE_DIVBYZERO) {
+ flags.set(RealFlag::DivideByZero);
+ }
+ if (exceptions & FE_OVERFLOW) {
+ flags.set(RealFlag::Overflow);
+ }
+ if (exceptions & FE_UNDERFLOW) {
+ flags.set(RealFlag::Underflow);
+ }
+ if (exceptions & FE_INEXACT) {
+ flags.set(RealFlag::Inexact);
+ }
+
+ if (flags.empty()) {
+ if (errnoCapture == EDOM) {
+ flags.set(RealFlag::InvalidArgument);
+ }
+ if (errnoCapture == ERANGE) {
+ // can't distinguish over/underflow from errno
+ flags.set(RealFlag::Overflow);
+ }
+ }
+
+ if (!flags.empty()) {
+ RealFlagWarnings(context, flags, "folding function with host runtime");
+ }
+ errno = 0;
+ if (fesetenv(&originalFenv_) != 0) {
+ std::fprintf(stderr, "fesetenv() failed: %s\n", std::strerror(errno));
+ common::die(
+ "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
+ std::strerror(errno));
+ }
+ errno = 0;
+}
+}
// to safely refer to this hardware type.
#include "type.h"
+#include <cfenv>
#include <complex>
#include <cstdint>
#include <limits>
namespace Fortran::evaluate {
namespace host {
+// Helper class to handle host runtime traps, status flag and errno
+class HostFloatingPointEnvironment {
+public:
+ void SetUpHostFloatingPointEnvironment(FoldingContext &);
+ void CheckAndRestoreFloatingPointEnvironment(FoldingContext &);
+
+private:
+ std::fenv_t originalFenv_;
+ std::fenv_t currentFenv_;
+};
+
// Type mapping from F18 types to host types
struct UnsupportedType {}; // There is no host type for the F18 type
#include "type.h"
#include "../common/template.h"
-#include <cfenv>
#include <tuple>
#include <type_traits>
namespace Fortran::evaluate {
// Define meaningful types for the runtime
-// TODO: add the support for void and descriptor
using RuntimeTypes = evaluate::AllIntrinsicTypes;
template<typename T, typename... TT> struct IndexInTupleHelper {};
using HostFuncPointer = FuncPointer<host::HostType<TR>,
HostArgType<typename ArgInfo::Type, ArgInfo::pass>...>;
-// Helper class to handle host runtime traps, status flag and errno
-class HostFloatingPointEnvironment {
-public:
- void SetUpHostFloatingPointEnvironment(FoldingContext &);
- void CheckAndRestoreFloatingPointEnvironment(FoldingContext &);
-
-private:
- std::fenv_t originalFenv_;
- std::fenv_t currentFenv_;
-};
-
// Callable factory
template<typename TR, typename... ArgInfo> struct CallableHostWrapper {
static Scalar<TR> scalarCallable(FoldingContext &context,
HostFuncPointer<TR, ArgInfo...> func,
const Scalar<typename ArgInfo::Type> &... x) {
if constexpr (host::HostTypeExists<TR, typename ArgInfo::Type...>()) {
- HostFloatingPointEnvironment hostFPE;
+ host::HostFloatingPointEnvironment hostFPE;
hostFPE.SetUpHostFloatingPointEnvironment(context);
host::HostType<TR> res{
func(host::CastFortranToHost<typename ArgInfo::Type>(x)...)};
// See the License for the specific language governing permissions and
// limitations under the License.
-// This file defines host runtimes functions that can be used for folding
+// This file defines host runtime functions that can be used for folding
// intrinsic functions.
// The default HostIntrinsicProceduresLibrary is built with <cmath> and
// <complex> functions that are guaranteed to exist from the C++ standard.
#include "intrinsics-library-templates.h"
-#include "../common/idioms.h"
-#include <cerrno>
-#include <cfenv>
-#include <sstream>
+#include <cmath>
+#include <complex>
namespace Fortran::evaluate {
-using namespace Fortran::parser::literals;
// Note: argument passing is ignored in equivalence
bool HostIntrinsicProceduresLibrary::HasEquivalentProcedure(
const IntrinsicProcedureRuntimeDescription &sym) const {
// Map numerical intrinsic to <cmath>/<complex> functions
-// TODO mapping to <cmath> function to be tested.<cmath> func takes
-// real arg for n
+// C++ Bessel functions take a floating point as first argument.
+// Fortran Bessel functions take an integer.
template<typename HostT> static HostT Bessel_jn(std::int64_t n, HostT x) {
return std::cyl_bessel_j(static_cast<HostT>(n), x);
}
}
}
-// Defines which host runtime functions will be used for folding
+// Define which host runtime functions will be used for folding
void HostIntrinsicProceduresLibrary::DefaultInit() {
AddLibmComplexHostProcedure<double>(*this);
AddLibmComplexHostProcedure<long double>(*this);
}
-
-void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
- FoldingContext &context) {
- errno = 0;
- if (feholdexcept(&originalFenv_) != 0) {
- common::die("Folding with host runtime: feholdexcept() failed: %s",
- std::strerror(errno));
- return;
- }
- if (fegetenv(¤tFenv_) != 0) {
- common::die("Folding with host runtime: fegetenv() failed: %s",
- std::strerror(errno));
- return;
- }
-#if __x86_64__
- if (context.flushSubnormalsToZero()) {
- currentFenv_.__mxcsr |= 0x8000; // result
- currentFenv_.__mxcsr |= 0x0040; // operands
- } else {
- currentFenv_.__mxcsr &= ~0x8000; // result
- currentFenv_.__mxcsr &= ~0x0040; // operands
- }
-#else
- // TODO other architectures
- context.messages().Say(
- "TODO: flushing mode for subnormals is not set for this host architecture when folding with host runtime functions"_en_US);
-#endif
- errno = 0;
- if (fesetenv(¤tFenv_) != 0) {
- common::die("Folding with host runtime: fesetenv() failed: %s",
- std::strerror(errno));
- return;
- }
- switch (context.rounding().mode) {
- case RoundingMode::TiesToEven: fesetround(FE_TONEAREST); break;
- case RoundingMode::ToZero: fesetround(FE_TOWARDZERO); break;
- case RoundingMode::Up: fesetround(FE_UPWARD); break;
- case RoundingMode::Down: fesetround(FE_DOWNWARD); break;
- case RoundingMode::TiesAwayFromZero:
- fesetround(FE_TONEAREST);
- context.messages().Say(
- "TiesAwayFromZero rounding mode is not available not available when folding constants with host runtime. Using TiesToEven instead."_en_US);
- break;
- }
- errno = 0;
-}
-void HostFloatingPointEnvironment::CheckAndRestoreFloatingPointEnvironment(
- FoldingContext &context) {
- int errnoCapture{errno};
- int exceptions{fetestexcept(FE_ALL_EXCEPT)};
- RealFlags flags;
- if (exceptions & FE_INVALID) {
- flags.set(RealFlag::InvalidArgument);
- }
- if (exceptions & FE_DIVBYZERO) {
- flags.set(RealFlag::DivideByZero);
- }
- if (exceptions & FE_OVERFLOW) {
- flags.set(RealFlag::Overflow);
- }
- if (exceptions & FE_UNDERFLOW) {
- flags.set(RealFlag::Underflow);
- }
- if (exceptions & FE_INEXACT) {
- flags.set(RealFlag::Inexact);
- }
-
- if (flags.empty()) {
- if (errnoCapture == EDOM) {
- flags.set(RealFlag::InvalidArgument);
- }
- if (errnoCapture == ERANGE) {
- // can't distinguish over/underflow from errno
- flags.set(RealFlag::Overflow);
- }
- }
-
- if (!flags.empty()) {
- RealFlagWarnings(context, flags, "folding function with host runtime");
- }
- errno = 0;
- if (fesetenv(&originalFenv_) != 0) {
- std::fprintf(stderr, "fesetenv() failed: %s\n", std::strerror(errno));
- common::die(
- "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
- std::strerror(errno));
- }
- errno = 0;
-}
}
projects / platform / upstream / llvm.git / commitdiff