| 12
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 
 | //===-- lib/Evaluate/host.h -------------------------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#ifndef FORTRAN_EVALUATE_HOST_H_
#define FORTRAN_EVALUATE_HOST_H_
// Define a compile-time mapping between Fortran intrinsic types and host
// hardware types if possible. The purpose is to avoid having to do any kind of
// assumption on whether a "float" matches the Scalar<Type<TypeCategory::Real,
// 4>> outside of this header. The main tools are HostTypeExists<T> and
// HostType<T>. HostTypeExists<T>() will return true if and only if a host
// hardware type maps to Fortran intrinsic type T. Then HostType<T> can be used
// to safely refer to this hardware type.
#include "flang/Evaluate/type.h"
#include <cfenv>
#include <complex>
#include <cstdint>
#include <limits>
#include <string>
#include <type_traits>
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 &);
  bool hasSubnormalFlushingHardwareControl() const {
    return hasSubnormalFlushingHardwareControl_;
  }
  void SetFlag(RealFlag flag) { flags_.set(flag); }
  bool hardwareFlagsAreReliable() const { return hardwareFlagsAreReliable_; }
private:
  std::fenv_t originalFenv_;
#if __x86_64__
  unsigned int originalMxcsr;
#endif
  RealFlags flags_;
  bool hasSubnormalFlushingHardwareControl_{false};
  bool hardwareFlagsAreReliable_{true};
};
// Type mapping from F18 types to host types
struct UnsupportedType {}; // There is no host type for the F18 type
template <typename FTN_T> struct HostTypeHelper {
  using Type = UnsupportedType;
};
template <typename FTN_T> using HostType = typename HostTypeHelper<FTN_T>::Type;
template <typename... T> constexpr inline bool HostTypeExists() {
  return (... && (!std::is_same_v<HostType<T>, UnsupportedType>));
}
// Type mapping from host types to F18 types FortranType<HOST_T> is defined
// after all HosTypeHelper definition because it reverses them to avoid
// duplication.
// Scalar conversion utilities from host scalars to F18 scalars
template <typename FTN_T>
inline constexpr Scalar<FTN_T> CastHostToFortran(const HostType<FTN_T> &x) {
  static_assert(HostTypeExists<FTN_T>());
  if constexpr (FTN_T::category == TypeCategory::Complex &&
      sizeof(Scalar<FTN_T>) != sizeof(HostType<FTN_T>)) {
    // X87 is usually padded to 12 or 16bytes. Need to cast piecewise for
    // complex
    return Scalar<FTN_T>{CastHostToFortran<typename FTN_T::Part>(std::real(x)),
        CastHostToFortran<typename FTN_T::Part>(std::imag(x))};
  } else {
    return *reinterpret_cast<const Scalar<FTN_T> *>(&x);
  }
}
// Scalar conversion utilities from  F18 scalars to host scalars
template <typename FTN_T>
inline constexpr HostType<FTN_T> CastFortranToHost(const Scalar<FTN_T> &x) {
  static_assert(HostTypeExists<FTN_T>());
  if constexpr (FTN_T::category == TypeCategory::Complex &&
      sizeof(Scalar<FTN_T>) != sizeof(HostType<FTN_T>)) {
    // X87 is usually padded to 12 or 16bytes. Need to cast piecewise for
    // complex
    return HostType<FTN_T>{CastFortranToHost<typename FTN_T::Part>(x.REAL()),
        CastFortranToHost<typename FTN_T::Part>(x.AIMAG())};
  } else {
    return *reinterpret_cast<const HostType<FTN_T> *>(&x);
  }
}
// Defining the actual mapping
template <> struct HostTypeHelper<Type<TypeCategory::Integer, 1>> {
  using Type = std::int8_t;
};
template <> struct HostTypeHelper<Type<TypeCategory::Integer, 2>> {
  using Type = std::int16_t;
};
template <> struct HostTypeHelper<Type<TypeCategory::Integer, 4>> {
  using Type = std::int32_t;
};
template <> struct HostTypeHelper<Type<TypeCategory::Integer, 8>> {
  using Type = std::int64_t;
};
template <> struct HostTypeHelper<Type<TypeCategory::Integer, 16>> {
#if (defined(__GNUC__) || defined(__clang__)) && defined(__SIZEOF_INT128__)
  using Type = __int128_t;
#else
  using Type = UnsupportedType;
#endif
};
// TODO no mapping to host types are defined currently for 16bits float
// It should be defined when gcc/clang have a better support for it.
template <>
struct HostTypeHelper<
    Type<TypeCategory::Real, common::RealKindForPrecision(24)>> {
  // IEEE 754 32bits
  using Type = std::conditional_t<sizeof(float) == 4 &&
          std::numeric_limits<float>::is_iec559,
      float, UnsupportedType>;
};
template <>
struct HostTypeHelper<
    Type<TypeCategory::Real, common::RealKindForPrecision(53)>> {
  // IEEE 754 64bits
  using Type = std::conditional_t<sizeof(double) == 8 &&
          std::numeric_limits<double>::is_iec559,
      double, UnsupportedType>;
};
template <>
struct HostTypeHelper<
    Type<TypeCategory::Real, common::RealKindForPrecision(64)>> {
  // X87 80bits
  using Type = std::conditional_t<sizeof(long double) >= 10 &&
          std::numeric_limits<long double>::digits == 64 &&
          std::numeric_limits<long double>::max_exponent == 16384,
      long double, UnsupportedType>;
};
template <>
struct HostTypeHelper<
    Type<TypeCategory::Real, common::RealKindForPrecision(113)>> {
  // IEEE 754 128bits
  using Type = std::conditional_t<sizeof(long double) == 16 &&
          std::numeric_limits<long double>::digits == 113 &&
          std::numeric_limits<long double>::max_exponent == 16384,
      long double, UnsupportedType>;
};
template <int KIND> struct HostTypeHelper<Type<TypeCategory::Complex, KIND>> {
  using RealT = Fortran::evaluate::Type<TypeCategory::Real, KIND>;
  using Type = std::conditional_t<HostTypeExists<RealT>(),
      std::complex<HostType<RealT>>, UnsupportedType>;
};
template <int KIND> struct HostTypeHelper<Type<TypeCategory::Logical, KIND>> {
  using Type = std::conditional_t<KIND <= 8, std::uint8_t, UnsupportedType>;
};
template <int KIND> struct HostTypeHelper<Type<TypeCategory::Character, KIND>> {
  using Type =
      Scalar<typename Fortran::evaluate::Type<TypeCategory::Character, KIND>>;
};
// Type mapping from host types to F18 types. This need to be placed after all
// HostTypeHelper specializations.
template <typename T, typename... TT> struct IndexInTupleHelper {};
template <typename T, typename... TT>
struct IndexInTupleHelper<T, std::tuple<TT...>> {
  static constexpr int value{common::TypeIndex<T, TT...>};
};
struct UnknownType {}; // the host type does not match any F18 types
template <typename HOST_T> struct FortranTypeHelper {
  using HostTypeMapping =
      common::MapTemplate<HostType, AllIntrinsicTypes, std::tuple>;
  static constexpr int index{
      IndexInTupleHelper<HOST_T, HostTypeMapping>::value};
  // Both conditional types are "instantiated", so a valid type must be
  // created for invalid index even if not used.
  using Type = std::conditional_t<index >= 0,
      std::tuple_element_t<(index >= 0) ? index : 0, AllIntrinsicTypes>,
      UnknownType>;
};
template <typename HOST_T>
using FortranType = typename FortranTypeHelper<HOST_T>::Type;
template <typename... HT> constexpr inline bool FortranTypeExists() {
  return (... && (!std::is_same_v<FortranType<HT>, UnknownType>));
}
} // namespace host
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_HOST_H_
 |