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 "stat.h"
  13 #include "terminator.h"
  14 #include "flang/Common/optional.h"
  15 #include "flang/Runtime/cpp-type.h"
  16 #include "flang/Runtime/descriptor.h"
  17 #include "flang/Runtime/freestanding-tools.h"
  18 #include "flang/Runtime/memory.h"
  19 #include <cstring>
  20 #include <functional>
  21 #include <map>
  22 #include <type_traits>
  23
  24 /// \macro RT_PRETTY_FUNCTION
  25 /// Gets a user-friendly looking function signature for the current scope
  26 /// using the best available method on each platform.  The exact format of the
  27 /// resulting string is implementation specific and non-portable, so this should
  28 /// only be used, for example, for logging or diagnostics.
  29 /// Copy of LLVM_PRETTY_FUNCTION
  30 #if defined(_MSC_VER)
  31 #define RT_PRETTY_FUNCTION __FUNCSIG__
  32 #elif defined(__GNUC__) || defined(__clang__)
  33 #define RT_PRETTY_FUNCTION __PRETTY_FUNCTION__
  34 #else
  35 #define RT_PRETTY_FUNCTION __func__
  36 #endif
  37
  38 #if defined(RT_DEVICE_COMPILATION)
  39 // Use the pseudo lock and pseudo file unit implementations
  40 // for the device.
  41 #define RT_USE_PSEUDO_LOCK 1
  42 #define RT_USE_PSEUDO_FILE_UNIT 1
  43 #endif
  44
  45 namespace Fortran::runtime {
  46
  47 class Terminator;
  48
  49 RT_API_ATTRS std::size_t TrimTrailingSpaces(const char *, std::size_t);
  50
  51 RT_API_ATTRS OwningPtr<char> SaveDefaultCharacter(
  52     const char *, std::size_t, const Terminator &);
  53
  54 // For validating and recognizing default CHARACTER values in a
  55 // case-insensitive manner.  Returns the zero-based index into the
  56 // null-terminated array of upper-case possibilities when the value is valid,
  57 // or -1 when it has no match.
  58 RT_API_ATTRS int IdentifyValue(
  59     const char *value, std::size_t length, const char *possibilities[]);
  60
  61 // Truncates or pads as necessary
  62 RT_API_ATTRS void ToFortranDefaultCharacter(
  63     char *to, std::size_t toLength, const char *from);
  64
  65 // Utilities for dealing with elemental LOGICAL arguments
  66 inline RT_API_ATTRS bool IsLogicalElementTrue(
  67     const Descriptor &logical, const SubscriptValue at[]) {
  68   // A LOGICAL value is false if and only if all of its bytes are zero.
  69   const char *p{logical.Element<char>(at)};
  70   for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) {
  71     if (*p) {
  72       return true;
  73     }
  74   }
  75   return false;
  76 }
  77 inline RT_API_ATTRS bool IsLogicalScalarTrue(const Descriptor &logical) {
  78   // A LOGICAL value is false if and only if all of its bytes are zero.
  79   const char *p{logical.OffsetElement<char>()};
  80   for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) {
  81     if (*p) {
  82       return true;
  83     }
  84   }
  85   return false;
  86 }
  87
  88 // Check array conformability; a scalar 'x' conforms.  Crashes on error.
  89 RT_API_ATTRS void CheckConformability(const Descriptor &to, const Descriptor &x,
  90     Terminator &, const char *funcName, const char *toName,
  91     const char *fromName);
  92
  93 // Helper to store integer value in result[at].
  94 template <int KIND> struct StoreIntegerAt {
  95   RT_API_ATTRS void operator()(const Fortran::runtime::Descriptor &result,
  96       std::size_t at, std::int64_t value) const {
  97     *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
  98         Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
  99   }
 100 };
 101
 102 // Helper to store floating value in result[at].
 103 template <int KIND> struct StoreFloatingPointAt {
 104   RT_API_ATTRS void operator()(const Fortran::runtime::Descriptor &result,
 105       std::size_t at, std::double_t value) const {
 106     *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
 107         Fortran::common::TypeCategory::Real, KIND>>(at) = value;
 108   }
 109 };
 110
 111 // Validate a KIND= argument
 112 RT_API_ATTRS void CheckIntegerKind(
 113     Terminator &, int kind, const char *intrinsic);
 114
 115 template <typename TO, typename FROM>
 116 inline RT_API_ATTRS void PutContiguousConverted(
 117     TO *to, FROM *from, std::size_t count) {
 118   while (count-- > 0) {
 119     *to++ = *from++;
 120   }
 121 }
 122
 123 static inline RT_API_ATTRS std::int64_t GetInt64(
 124     const char *p, std::size_t bytes, Terminator &terminator) {
 125   switch (bytes) {
 126   case 1:
 127     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
 128   case 2:
 129     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
 130   case 4:
 131     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
 132   case 8:
 133     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
 134   default:
 135     terminator.Crash("GetInt64: no case for %zd bytes", bytes);
 136   }
 137 }
 138
 139 static inline RT_API_ATTRS Fortran::common::optional<std::int64_t> GetInt64Safe(
 140     const char *p, std::size_t bytes, Terminator &terminator) {
 141   switch (bytes) {
 142   case 1:
 143     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
 144   case 2:
 145     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
 146   case 4:
 147     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
 148   case 8:
 149     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
 150   case 16: {
 151     using Int128 = CppTypeFor<TypeCategory::Integer, 16>;
 152     auto n{*reinterpret_cast<const Int128 *>(p)};
 153     std::int64_t result{static_cast<std::int64_t>(n)};
 154     if (static_cast<Int128>(result) == n) {
 155       return result;
 156     }
 157     return Fortran::common::nullopt;
 158   }
 159   default:
 160     terminator.Crash("GetInt64Safe: no case for %zd bytes", bytes);
 161   }
 162 }
 163
 164 template <typename INT>
 165 inline RT_API_ATTRS bool SetInteger(INT &x, int kind, std::int64_t value) {
 166   switch (kind) {
 167   case 1:
 168     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
 169     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x);
 170   case 2:
 171     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x) = value;
 172     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x);
 173   case 4:
 174     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x) = value;
 175     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x);
 176   case 8:
 177     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
 178     return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x);
 179   default:
 180     return false;
 181   }
 182 }
 183
 184 // Maps intrinsic runtime type category and kind values to the appropriate
 185 // instantiation of a function object template and calls it with the supplied
 186 // arguments.
 187 template <template <TypeCategory, int> class FUNC, typename RESULT,
 188     typename... A>
 189 inline RT_API_ATTRS RESULT ApplyType(
 190     TypeCategory cat, int kind, Terminator &terminator, A &&...x) {
 191   switch (cat) {
 192   case TypeCategory::Integer:
 193     switch (kind) {
 194     case 1:
 195       return FUNC<TypeCategory::Integer, 1>{}(std::forward<A>(x)...);
 196     case 2:
 197       return FUNC<TypeCategory::Integer, 2>{}(std::forward<A>(x)...);
 198     case 4:
 199       return FUNC<TypeCategory::Integer, 4>{}(std::forward<A>(x)...);
 200     case 8:
 201       return FUNC<TypeCategory::Integer, 8>{}(std::forward<A>(x)...);
 202 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
 203     case 16:
 204       return FUNC<TypeCategory::Integer, 16>{}(std::forward<A>(x)...);
 205 #endif
 206     default:
 207       terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
 208     }
 209   case TypeCategory::Unsigned:
 210     switch (kind) {
 211     case 1:
 212       return FUNC<TypeCategory::Unsigned, 1>{}(std::forward<A>(x)...);
 213     case 2:
 214       return FUNC<TypeCategory::Unsigned, 2>{}(std::forward<A>(x)...);
 215     case 4:
 216       return FUNC<TypeCategory::Unsigned, 4>{}(std::forward<A>(x)...);
 217     case 8:
 218       return FUNC<TypeCategory::Unsigned, 8>{}(std::forward<A>(x)...);
 219 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
 220     case 16:
 221       return FUNC<TypeCategory::Unsigned, 16>{}(std::forward<A>(x)...);
 222 #endif
 223     default:
 224       terminator.Crash("not yet implemented: UNSIGNED(KIND=%d)", kind);
 225     }
 226   case TypeCategory::Real:
 227     switch (kind) {
 228 #if 0 // TODO: REAL(2 & 3)
 229     case 2:
 230       return FUNC<TypeCategory::Real, 2>{}(std::forward<A>(x)...);
 231     case 3:
 232       return FUNC<TypeCategory::Real, 3>{}(std::forward<A>(x)...);
 233 #endif
 234     case 4:
 235       return FUNC<TypeCategory::Real, 4>{}(std::forward<A>(x)...);
 236     case 8:
 237       return FUNC<TypeCategory::Real, 8>{}(std::forward<A>(x)...);
 238     case 10:
 239       if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 240         return FUNC<TypeCategory::Real, 10>{}(std::forward<A>(x)...);
 241       }
 242       break;
 243     case 16:
 244       if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 245         return FUNC<TypeCategory::Real, 16>{}(std::forward<A>(x)...);
 246       }
 247       break;
 248     }
 249     terminator.Crash("not yet implemented: REAL(KIND=%d)", kind);
 250   case TypeCategory::Complex:
 251     switch (kind) {
 252 #if 0 // TODO: COMPLEX(2 & 3)
 253     case 2:
 254       return FUNC<TypeCategory::Complex, 2>{}(std::forward<A>(x)...);
 255     case 3:
 256       return FUNC<TypeCategory::Complex, 3>{}(std::forward<A>(x)...);
 257 #endif
 258     case 4:
 259       return FUNC<TypeCategory::Complex, 4>{}(std::forward<A>(x)...);
 260     case 8:
 261       return FUNC<TypeCategory::Complex, 8>{}(std::forward<A>(x)...);
 262     case 10:
 263       if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 264         return FUNC<TypeCategory::Complex, 10>{}(std::forward<A>(x)...);
 265       }
 266       break;
 267     case 16:
 268       if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 269         return FUNC<TypeCategory::Complex, 16>{}(std::forward<A>(x)...);
 270       }
 271       break;
 272     }
 273     terminator.Crash("not yet implemented: COMPLEX(KIND=%d)", kind);
 274   case TypeCategory::Character:
 275     switch (kind) {
 276     case 1:
 277       return FUNC<TypeCategory::Character, 1>{}(std::forward<A>(x)...);
 278     case 2:
 279       return FUNC<TypeCategory::Character, 2>{}(std::forward<A>(x)...);
 280     case 4:
 281       return FUNC<TypeCategory::Character, 4>{}(std::forward<A>(x)...);
 282     default:
 283       terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
 284     }
 285   case TypeCategory::Logical:
 286     switch (kind) {
 287     case 1:
 288       return FUNC<TypeCategory::Logical, 1>{}(std::forward<A>(x)...);
 289     case 2:
 290       return FUNC<TypeCategory::Logical, 2>{}(std::forward<A>(x)...);
 291     case 4:
 292       return FUNC<TypeCategory::Logical, 4>{}(std::forward<A>(x)...);
 293     case 8:
 294       return FUNC<TypeCategory::Logical, 8>{}(std::forward<A>(x)...);
 295     default:
 296       terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
 297     }
 298   default:
 299     terminator.Crash(
 300         "not yet implemented: type category(%d)", static_cast<int>(cat));
 301   }
 302 }
 303
 304 // Maps a runtime INTEGER kind value to the appropriate instantiation of
 305 // a function object template and calls it with the supplied arguments.
 306 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 307 inline RT_API_ATTRS RESULT ApplyIntegerKind(
 308     int kind, Terminator &terminator, A &&...x) {
 309   switch (kind) {
 310   case 1:
 311     return FUNC<1>{}(std::forward<A>(x)...);
 312   case 2:
 313     return FUNC<2>{}(std::forward<A>(x)...);
 314   case 4:
 315     return FUNC<4>{}(std::forward<A>(x)...);
 316   case 8:
 317     return FUNC<8>{}(std::forward<A>(x)...);
 318 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
 319   case 16:
 320     return FUNC<16>{}(std::forward<A>(x)...);
 321 #endif
 322   default:
 323     terminator.Crash("not yet implemented: INTEGER/UNSIGNED(KIND=%d)", kind);
 324   }
 325 }
 326
 327 template <template <int KIND> class FUNC, typename RESULT,
 328     bool NEEDSMATH = false, typename... A>
 329 inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
 330     int kind, Terminator &terminator, A &&...x) {
 331   switch (kind) {
 332 #if 0 // TODO: REAL/COMPLEX (2 & 3)
 333   case 2:
 334     return FUNC<2>{}(std::forward<A>(x)...);
 335   case 3:
 336     return FUNC<3>{}(std::forward<A>(x)...);
 337 #endif
 338   case 4:
 339     return FUNC<4>{}(std::forward<A>(x)...);
 340   case 8:
 341     return FUNC<8>{}(std::forward<A>(x)...);
 342   case 10:
 343     if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
 344       return FUNC<10>{}(std::forward<A>(x)...);
 345     }
 346     break;
 347   case 16:
 348     if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
 349       // If FUNC implemenation relies on FP math functions,
 350       // then we should not be here. The compiler should have
 351       // generated a call to an entry in FortranFloat128Math
 352       // library.
 353       if constexpr (!NEEDSMATH) {
 354         return FUNC<16>{}(std::forward<A>(x)...);
 355       }
 356     }
 357     break;
 358   }
 359   terminator.Crash("not yet implemented: REAL/COMPLEX(KIND=%d)", kind);
 360 }
 361
 362 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 363 inline RT_API_ATTRS RESULT ApplyCharacterKind(
 364     int kind, Terminator &terminator, A &&...x) {
 365   switch (kind) {
 366   case 1:
 367     return FUNC<1>{}(std::forward<A>(x)...);
 368   case 2:
 369     return FUNC<2>{}(std::forward<A>(x)...);
 370   case 4:
 371     return FUNC<4>{}(std::forward<A>(x)...);
 372   default:
 373     terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
 374   }
 375 }
 376
 377 template <template <int KIND> class FUNC, typename RESULT, typename... A>
 378 inline RT_API_ATTRS RESULT ApplyLogicalKind(
 379     int kind, Terminator &terminator, A &&...x) {
 380   switch (kind) {
 381   case 1:
 382     return FUNC<1>{}(std::forward<A>(x)...);
 383   case 2:
 384     return FUNC<2>{}(std::forward<A>(x)...);
 385   case 4:
 386     return FUNC<4>{}(std::forward<A>(x)...);
 387   case 8:
 388     return FUNC<8>{}(std::forward<A>(x)...);
 389   default:
 390     terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
 391   }
 392 }
 393
 394 // Calculate result type of (X op Y) for *, //, DOT_PRODUCT, &c.
 395 Fortran::common::optional<
 396     std::pair<TypeCategory, int>> inline constexpr RT_API_ATTRS
 397 GetResultType(TypeCategory xCat, int xKind, TypeCategory yCat, int yKind) {
 398   int maxKind{std::max(xKind, yKind)};
 399   switch (xCat) {
 400   case TypeCategory::Integer:
 401     switch (yCat) {
 402     case TypeCategory::Integer:
 403       return std::make_pair(TypeCategory::Integer, maxKind);
 404     case TypeCategory::Real:
 405     case TypeCategory::Complex:
 406 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 407       if (xKind == 16) {
 408         break;
 409       }
 410 #endif
 411       return std::make_pair(yCat, yKind);
 412     default:
 413       break;
 414     }
 415     break;
 416   case TypeCategory::Unsigned:
 417     switch (yCat) {
 418     case TypeCategory::Unsigned:
 419       return std::make_pair(TypeCategory::Unsigned, maxKind);
 420     case TypeCategory::Real:
 421     case TypeCategory::Complex:
 422 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 423       if (xKind == 16) {
 424         break;
 425       }
 426 #endif
 427       return std::make_pair(yCat, yKind);
 428     default:
 429       break;
 430     }
 431     break;
 432   case TypeCategory::Real:
 433     switch (yCat) {
 434     case TypeCategory::Integer:
 435     case TypeCategory::Unsigned:
 436 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 437       if (yKind == 16) {
 438         break;
 439       }
 440 #endif
 441       return std::make_pair(TypeCategory::Real, xKind);
 442     case TypeCategory::Real:
 443     case TypeCategory::Complex:
 444       return std::make_pair(yCat, maxKind);
 445     default:
 446       break;
 447     }
 448     break;
 449   case TypeCategory::Complex:
 450     switch (yCat) {
 451     case TypeCategory::Integer:
 452     case TypeCategory::Unsigned:
 453 #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T)
 454       if (yKind == 16) {
 455         break;
 456       }
 457 #endif
 458       return std::make_pair(TypeCategory::Complex, xKind);
 459     case TypeCategory::Real:
 460     case TypeCategory::Complex:
 461       return std::make_pair(TypeCategory::Complex, maxKind);
 462     default:
 463       break;
 464     }
 465     break;
 466   case TypeCategory::Character:
 467     if (yCat == TypeCategory::Character) {
 468       return std::make_pair(TypeCategory::Character, maxKind);
 469     } else {
 470       return Fortran::common::nullopt;
 471     }
 472   case TypeCategory::Logical:
 473     if (yCat == TypeCategory::Logical) {
 474       return std::make_pair(TypeCategory::Logical, maxKind);
 475     } else {
 476       return Fortran::common::nullopt;
 477     }
 478   default:
 479     break;
 480   }
 481   return Fortran::common::nullopt;
 482 }
 483
 484 // Accumulate floating-point results in (at least) double precision
 485 template <TypeCategory CAT, int KIND>
 486 using AccumulationType = CppTypeFor<CAT,
 487     CAT == TypeCategory::Real || CAT == TypeCategory::Complex
 488         ? std::max(KIND, static_cast<int>(sizeof(double)))
 489         : KIND>;
 490
 491 // memchr() for any character type
 492 template <typename CHAR>
 493 static inline RT_API_ATTRS const CHAR *FindCharacter(
 494     const CHAR *data, CHAR ch, std::size_t chars) {
 495   const CHAR *end{data + chars};
 496   for (const CHAR *p{data}; p < end; ++p) {
 497     if (*p == ch) {
 498       return p;
 499     }
 500   }
 501   return nullptr;
 502 }
 503
 504 template <>
 505 inline RT_API_ATTRS const char *FindCharacter(
 506     const char *data, char ch, std::size_t chars) {
 507   return reinterpret_cast<const char *>(
 508       runtime::memchr(data, static_cast<int>(ch), chars));
 509 }
 510
 511 // Copy payload data from one allocated descriptor to another.
 512 // Assumes element counts and element sizes match, and that both
 513 // descriptors are allocated.
 514 RT_API_ATTRS void ShallowCopyDiscontiguousToDiscontiguous(
 515     const Descriptor &to, const Descriptor &from);
 516 RT_API_ATTRS void ShallowCopyDiscontiguousToContiguous(
 517     const Descriptor &to, const Descriptor &from);
 518 RT_API_ATTRS void ShallowCopyContiguousToDiscontiguous(
 519     const Descriptor &to, const Descriptor &from);
 520 RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from,
 521     bool toIsContiguous, bool fromIsContiguous);
 522 RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
 523
 524 // Ensures that a character string is null-terminated, allocating a /p length +1
 525 // size memory for null-terminator if necessary. Returns the original or a newly
 526 // allocated null-terminated string (responsibility for deallocation is on the
 527 // caller).
 528 RT_API_ATTRS char *EnsureNullTerminated(
 529     char *str, std::size_t length, Terminator &terminator);
 530
 531 RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value);
 532
 533 RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal);
 534
 535 // Copy a null-terminated character array \p rawValue to descriptor \p value.
 536 // The copy starts at the given \p offset, if not present then start at 0.
 537 // If descriptor `errmsg` is provided, error messages will be stored to it.
 538 // Returns stats specified in standard.
 539 RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value,
 540     const char *rawValue, std::size_t rawValueLength,
 541     const Descriptor *errmsg = nullptr, std::size_t offset = 0);
 542
 543 RT_API_ATTRS void StoreIntToDescriptor(
 544     const Descriptor *length, std::int64_t value, Terminator &terminator);
 545
 546 // Defines a utility function for copying and padding characters
 547 template <typename TO, typename FROM>
 548 RT_API_ATTRS void CopyAndPad(
 549     TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
 550   if constexpr (sizeof(TO) != sizeof(FROM)) {
 551     std::size_t copyChars{std::min(toChars, fromChars)};
 552     for (std::size_t j{0}; j < copyChars; ++j) {
 553       to[j] = from[j];
 554     }
 555     for (std::size_t j{copyChars}; j < toChars; ++j) {
 556       to[j] = static_cast<TO>(' ');
 557     }
 558   } else if (toChars <= fromChars) {
 559     std::memcpy(to, from, toChars * sizeof(TO));
 560   } else {
 561     std::memcpy(to, from, std::min(toChars, fromChars) * sizeof(TO));
 562     for (std::size_t j{fromChars}; j < toChars; ++j) {
 563       to[j] = static_cast<TO>(' ');
 564     }
 565   }
 566 }
 567
 568 RT_API_ATTRS void CreatePartialReductionResult(Descriptor &result,
 569     const Descriptor &x, std::size_t resultElementSize, int dim, Terminator &,
 570     const char *intrinsic, TypeCode);
 571
 572 } // namespace Fortran::runtime
 573 #endif // FORTRAN_RUNTIME_TOOLS_H_