flang/runtime/tools.h

   1 //===-- runtime/tools.h -----------------------------------------*- C++ -*-===//
   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 #ifndef FORTRAN_RUNTIME_TOOLS_H_
  10 #define FORTRAN_RUNTIME_TOOLS_H_
  11
  12 #include "freestanding-tools.h"
  13 #include "terminator.h"
  14 #include "flang/Runtime/cpp-type.h"
  15 #include "flang/Runtime/descriptor.h"
  16 #include "flang/Runtime/memory.h"
  17 #include <cstring>
  18 #include <functional>
  19 #include <map>
  20 #include <type_traits>
  21
  22 namespace Fortran::runtime {
  23
  24 class Terminator;
  25
  26 RT_API_ATTRS std::size_t TrimTrailingSpaces(const char *, std::size_t);
  27
  28 RT_API_ATTRS OwningPtr<char> SaveDefaultCharacter(
  29     const char *, std::size_t, const Terminator &);
  30
  31 // For validating and recognizing default CHARACTER values in a
  32 // case-insensitive manner.  Returns the zero-based index into the
  33 // null-terminated array of upper-case possibilities when the value is valid,
  34 // or -1 when it has no match.
  35 RT_API_ATTRS int IdentifyValue(
  36     const char *value, std::size_t length, const char *possibilities[]);
  37
  38 // Truncates or pads as necessary
  39 RT_API_ATTRS void ToFortranDefaultCharacter(
  40     char *to, std::size_t toLength, const char *from);
  41
  42 // Utility for dealing with elemental LOGICAL arguments
  43 inline RT_API_ATTRS bool IsLogicalElementTrue(
  44     const Descriptor &logical, const SubscriptValue at[]) {
  45   // A LOGICAL value is false if and only if all of its bytes are zero.
  46   const char *p{logical.Element<char>(at)};
  47   for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) {
  48     if (*p) {
  49       return true;
  50     }
  51   }
  52   return false;
  53 }
  54
  55 // Check array conformability; a scalar 'x' conforms.  Crashes on error.
  56 RT_API_ATTRS void CheckConformability(const Descriptor &to, const Descriptor &x,
  57     Terminator &, const char *funcName, const char *toName,
  58     const char *fromName);
  59
  60 // Helper to store integer value in result[at].
  61 template <int KIND> struct StoreIntegerAt {
  62   RT_API_ATTRS void operator()(const Fortran::runtime::Descriptor &result,
  63       std::size_t at, std::int64_t value) const {
  64     *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
  65         Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
  66   }
  67 };
  68
  69 // Validate a KIND= argument
  70 RT_API_ATTRS void CheckIntegerKind(
  71     Terminator &, int kind, const char *intrinsic);
  72
  73 template <typename TO, typename FROM>
  74 inline RT_API_ATTRS void PutContiguousConverted(
  75     TO *to, FROM *from, std::size_t count) {
  76   while (count-- > 0) {
  77     *to++ = *from++;
  78   }
  79 }
  80
  81 static inline RT_API_ATTRS std::int64_t GetInt64(
  82     const char *p, std::size_t bytes, Terminator &terminator) {
  83   switch (bytes) {
  84   case 1:
  85     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
  86   case 2:
  87     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
  88   case 4:
  89     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
  90   case 8:
  91     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
  92   default:
  93     terminator.Crash("GetInt64: no case for %zd bytes", bytes);
  94   }
  95 }
  96
  97 template <typename INT>
  98 inline RT_API_ATTRS bool SetInteger(INT &x, int kind, std::int64_t value) {
  99   switch (kind) {
 100   case 1:
 101     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
 102     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x);
 103   case 2:
 104     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x) = value;
 105     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x);
 106   case 4:
 107     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x) = value;
 108     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x);
 109   case 8:
 110     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
 111     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x);
 112   default:
 113     return false;
 114   }
 115 }
 116
 117 // Maps intrinsic runtime type category and kind values to the appropriate
 118 // instantiation of a function object template and calls it with the supplied
 119 // arguments.
 120 template <template <TypeCategory, int> class FUNC, typename RESULT,
 121     typename... A>
 122 inline RT_API_ATTRS RESULT ApplyType(
 123     TypeCategory cat, int kind, Terminator &terminator, A &&...x) {
 124   switch (cat) {
 125   case TypeCategory::Integer:
 126     switch (kind) {
 127     case 1:
 128       return FUNC<TypeCategory::Integer, 1>{}(std::forward<A>(x)...);
 129     case 2:
 130       return FUNC<TypeCategory::Integer, 2>{}(std::forward<A>(x)...);
 131     case 4:
 132       return FUNC<TypeCategory::Integer, 4>{}(std::forward<A>(x)...);
 133     case 8:
 134       return FUNC<TypeCategory::Integer, 8>{}(std::forward<A>(x)...);
 135 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
 136     case 16:
 137       return FUNC<TypeCategory::Integer, 16>{}(std::forward<A>(x)...);
 138 #endif
 139     default:
 140       terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
 141     }
 142   case TypeCategory::Real:
 143     switch (kind) {
 144 #if 0 // TODO: REAL(2 & 3)
 145     case 2:
 146       return FUNC<TypeCategory::Real, 2>{}(std::forward<A>(x)...);
 147     case 3:
 148       return FUNC<TypeCategory::Real, 3>{}(std::forward<A>(x)...);
 149 #endif
 150     case 4:
 151       return FUNC<TypeCategory::Real, 4>{}(std::forward<A>(x)...);
 152     case 8:
 153       return FUNC<TypeCategory::Real, 8>{}(std::forward<A>(x)...);
 154     case 10:
 155       if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 156         return FUNC<TypeCategory::Real, 10>{}(std::forward<A>(x)...);
 157       }
 158       break;
 159     case 16:
 160       if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 161         return FUNC<TypeCategory::Real, 16>{}(std::forward<A>(x)...);
 162       }
 163       break;
 164     }
 165     terminator.Crash("not yet implemented: REAL(KIND=%d)", kind);
 166   case TypeCategory::Complex:
 167     switch (kind) {
 168 #if 0 // TODO: COMPLEX(2 & 3)
 169     case 2:
 170       return FUNC<TypeCategory::Complex, 2>{}(std::forward<A>(x)...);
 171     case 3:
 172       return FUNC<TypeCategory::Complex, 3>{}(std::forward<A>(x)...);
 173 #endif
 174     case 4:
 175       return FUNC<TypeCategory::Complex, 4>{}(std::forward<A>(x)...);
 176     case 8:
 177       return FUNC<TypeCategory::Complex, 8>{}(std::forward<A>(x)...);
 178     case 10:
 179       if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 180         return FUNC<TypeCategory::Complex, 10>{}(std::forward<A>(x)...);
 181       }
 182       break;
 183     case 16:
 184       if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 185         return FUNC<TypeCategory::Complex, 16>{}(std::forward<A>(x)...);
 186       }
 187       break;
 188     }
 189     terminator.Crash("not yet implemented: COMPLEX(KIND=%d)", kind);
 190   case TypeCategory::Character:
 191     switch (kind) {
 192     case 1:
 193       return FUNC<TypeCategory::Character, 1>{}(std::forward<A>(x)...);
 194     case 2:
 195       return FUNC<TypeCategory::Character, 2>{}(std::forward<A>(x)...);
 196     case 4:
 197       return FUNC<TypeCategory::Character, 4>{}(std::forward<A>(x)...);
 198     default:
 199       terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
 200     }
 201   case TypeCategory::Logical:
 202     switch (kind) {
 203     case 1:
 204       return FUNC<TypeCategory::Logical, 1>{}(std::forward<A>(x)...);
 205     case 2:
 206       return FUNC<TypeCategory::Logical, 2>{}(std::forward<A>(x)...);
 207     case 4:
 208       return FUNC<TypeCategory::Logical, 4>{}(std::forward<A>(x)...);
 209     case 8:
 210       return FUNC<TypeCategory::Logical, 8>{}(std::forward<A>(x)...);
 211     default:
 212       terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
 213     }
 214   default:
 215     terminator.Crash(
 216         "not yet implemented: type category(%d)", static_cast<int>(cat));
 217   }
 218 }
 219
 220 // Maps a runtime INTEGER kind value to the appropriate instantiation of
 221 // a function object template and calls it with the supplied arguments.
 222 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 223 inline RT_API_ATTRS RESULT ApplyIntegerKind(
 224     int kind, Terminator &terminator, A &&...x) {
 225   switch (kind) {
 226   case 1:
 227     return FUNC<1>{}(std::forward<A>(x)...);
 228   case 2:
 229     return FUNC<2>{}(std::forward<A>(x)...);
 230   case 4:
 231     return FUNC<4>{}(std::forward<A>(x)...);
 232   case 8:
 233     return FUNC<8>{}(std::forward<A>(x)...);
 234 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
 235   case 16:
 236     return FUNC<16>{}(std::forward<A>(x)...);
 237 #endif
 238   default:
 239     terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
 240   }
 241 }
 242
 243 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 244 inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
 245     int kind, Terminator &terminator, A &&...x) {
 246   switch (kind) {
 247 #if 0 // TODO: REAL/COMPLEX (2 & 3)
 248   case 2:
 249     return FUNC<2>{}(std::forward<A>(x)...);
 250   case 3:
 251     return FUNC<3>{}(std::forward<A>(x)...);
 252 #endif
 253   case 4:
 254     return FUNC<4>{}(std::forward<A>(x)...);
 255   case 8:
 256     return FUNC<8>{}(std::forward<A>(x)...);
 257   case 10:
 258     if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 259       return FUNC<10>{}(std::forward<A>(x)...);
 260     }
 261     break;
 262   case 16:
 263     if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 264       return FUNC<16>{}(std::forward<A>(x)...);
 265     }
 266     break;
 267   }
 268   terminator.Crash("not yet implemented: REAL/COMPLEX(KIND=%d)", kind);
 269 }
 270
 271 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 272 inline RT_API_ATTRS RESULT ApplyCharacterKind(
 273     int kind, Terminator &terminator, A &&...x) {
 274   switch (kind) {
 275   case 1:
 276     return FUNC<1>{}(std::forward<A>(x)...);
 277   case 2:
 278     return FUNC<2>{}(std::forward<A>(x)...);
 279   case 4:
 280     return FUNC<4>{}(std::forward<A>(x)...);
 281   default:
 282     terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
 283   }
 284 }
 285
 286 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 287 inline RT_API_ATTRS RESULT ApplyLogicalKind(
 288     int kind, Terminator &terminator, A &&...x) {
 289   switch (kind) {
 290   case 1:
 291     return FUNC<1>{}(std::forward<A>(x)...);
 292   case 2:
 293     return FUNC<2>{}(std::forward<A>(x)...);
 294   case 4:
 295     return FUNC<4>{}(std::forward<A>(x)...);
 296   case 8:
 297     return FUNC<8>{}(std::forward<A>(x)...);
 298   default:
 299     terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
 300   }
 301 }
 302
 303 // Calculate result type of (X op Y) for *, //, DOT_PRODUCT, &c.
 304 std::optional<std::pair<TypeCategory, int>> inline constexpr RT_API_ATTRS
 305 GetResultType(TypeCategory xCat, int xKind, TypeCategory yCat, int yKind) {
 306   int maxKind{std::max(xKind, yKind)};
 307   switch (xCat) {
 308   case TypeCategory::Integer:
 309     switch (yCat) {
 310     case TypeCategory::Integer:
 311       return std::make_pair(TypeCategory::Integer, maxKind);
 312     case TypeCategory::Real:
 313     case TypeCategory::Complex:
 314 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 315       if (xKind == 16) {
 316         break;
 317       }
 318 #endif
 319       return std::make_pair(yCat, yKind);
 320     default:
 321       break;
 322     }
 323     break;
 324   case TypeCategory::Real:
 325     switch (yCat) {
 326     case TypeCategory::Integer:
 327 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 328       if (yKind == 16) {
 329         break;
 330       }
 331 #endif
 332       return std::make_pair(TypeCategory::Real, xKind);
 333     case TypeCategory::Real:
 334     case TypeCategory::Complex:
 335       return std::make_pair(yCat, maxKind);
 336     default:
 337       break;
 338     }
 339     break;
 340   case TypeCategory::Complex:
 341     switch (yCat) {
 342     case TypeCategory::Integer:
 343 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 344       if (yKind == 16) {
 345         break;
 346       }
 347 #endif
 348       return std::make_pair(TypeCategory::Complex, xKind);
 349     case TypeCategory::Real:
 350     case TypeCategory::Complex:
 351       return std::make_pair(TypeCategory::Complex, maxKind);
 352     default:
 353       break;
 354     }
 355     break;
 356   case TypeCategory::Character:
 357     if (yCat == TypeCategory::Character) {
 358       return std::make_pair(TypeCategory::Character, maxKind);
 359     } else {
 360       return std::nullopt;
 361     }
 362   case TypeCategory::Logical:
 363     if (yCat == TypeCategory::Logical) {
 364       return std::make_pair(TypeCategory::Logical, maxKind);
 365     } else {
 366       return std::nullopt;
 367     }
 368   default:
 369     break;
 370   }
 371   return std::nullopt;
 372 }
 373
 374 // Accumulate floating-point results in (at least) double precision
 375 template <TypeCategory CAT, int KIND>
 376 using AccumulationType = CppTypeFor<CAT,
 377     CAT == TypeCategory::Real || CAT == TypeCategory::Complex
 378         ? std::max(KIND, static_cast<int>(sizeof(double)))
 379         : KIND>;
 380
 381 // memchr() for any character type
 382 template <typename CHAR>
 383 static inline RT_API_ATTRS const CHAR *FindCharacter(
 384     const CHAR *data, CHAR ch, std::size_t chars) {
 385   const CHAR *end{data + chars};
 386   for (const CHAR *p{data}; p < end; ++p) {
 387     if (*p == ch) {
 388       return p;
 389     }
 390   }
 391   return nullptr;
 392 }
 393
 394 template <>
 395 inline RT_API_ATTRS const char *FindCharacter(
 396     const char *data, char ch, std::size_t chars) {
 397   return reinterpret_cast<const char *>(
 398       std::memchr(data, static_cast<int>(ch), chars));
 399 }
 400
 401 // Copy payload data from one allocated descriptor to another.
 402 // Assumes element counts and element sizes match, and that both
 403 // descriptors are allocated.
 404 RT_API_ATTRS void ShallowCopyDiscontiguousToDiscontiguous(
 405     const Descriptor &to, const Descriptor &from);
 406 RT_API_ATTRS void ShallowCopyDiscontiguousToContiguous(
 407     const Descriptor &to, const Descriptor &from);
 408 RT_API_ATTRS void ShallowCopyContiguousToDiscontiguous(
 409     const Descriptor &to, const Descriptor &from);
 410 RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from,
 411     bool toIsContiguous, bool fromIsContiguous);
 412 RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
 413
 414 } // namespace Fortran::runtime
 415 #endif // FORTRAN_RUNTIME_TOOLS_H_