//===-- runtime/tools.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_RUNTIME_TOOLS_H_ #define FORTRAN_RUNTIME_TOOLS_H_ #include "freestanding-tools.h" #include "stat.h" #include "terminator.h" #include "flang/Runtime/cpp-type.h" #include "flang/Runtime/descriptor.h" #include "flang/Runtime/memory.h" #include #include #include #include namespace Fortran::runtime { class Terminator; RT_API_ATTRS std::size_t TrimTrailingSpaces(const char *, std::size_t); RT_API_ATTRS OwningPtr SaveDefaultCharacter( const char *, std::size_t, const Terminator &); // For validating and recognizing default CHARACTER values in a // case-insensitive manner. Returns the zero-based index into the // null-terminated array of upper-case possibilities when the value is valid, // or -1 when it has no match. RT_API_ATTRS int IdentifyValue( const char *value, std::size_t length, const char *possibilities[]); // Truncates or pads as necessary RT_API_ATTRS void ToFortranDefaultCharacter( char *to, std::size_t toLength, const char *from); // Utility for dealing with elemental LOGICAL arguments inline RT_API_ATTRS bool IsLogicalElementTrue( const Descriptor &logical, const SubscriptValue at[]) { // A LOGICAL value is false if and only if all of its bytes are zero. const char *p{logical.Element(at)}; for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) { if (*p) { return true; } } return false; } // Check array conformability; a scalar 'x' conforms. Crashes on error. RT_API_ATTRS void CheckConformability(const Descriptor &to, const Descriptor &x, Terminator &, const char *funcName, const char *toName, const char *fromName); // Helper to store integer value in result[at]. template struct StoreIntegerAt { RT_API_ATTRS void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, std::int64_t value) const { *result.ZeroBasedIndexedElement>(at) = value; } }; // Validate a KIND= argument RT_API_ATTRS void CheckIntegerKind( Terminator &, int kind, const char *intrinsic); template inline RT_API_ATTRS void PutContiguousConverted( TO *to, FROM *from, std::size_t count) { while (count-- > 0) { *to++ = *from++; } } static inline RT_API_ATTRS std::int64_t GetInt64( const char *p, std::size_t bytes, Terminator &terminator) { switch (bytes) { case 1: return *reinterpret_cast *>(p); case 2: return *reinterpret_cast *>(p); case 4: return *reinterpret_cast *>(p); case 8: return *reinterpret_cast *>(p); default: terminator.Crash("GetInt64: no case for %zd bytes", bytes); } } static inline RT_API_ATTRS std::optional GetInt64Safe( const char *p, std::size_t bytes, Terminator &terminator) { switch (bytes) { case 1: return *reinterpret_cast *>(p); case 2: return *reinterpret_cast *>(p); case 4: return *reinterpret_cast *>(p); case 8: return *reinterpret_cast *>(p); case 16: { using Int128 = CppTypeFor; auto n{*reinterpret_cast(p)}; std::int64_t result{static_cast(n)}; if (static_cast(result) == n) { return result; } return std::nullopt; } default: terminator.Crash("GetInt64Safe: no case for %zd bytes", bytes); } } template inline RT_API_ATTRS bool SetInteger(INT &x, int kind, std::int64_t value) { switch (kind) { case 1: reinterpret_cast &>(x) = value; return value == reinterpret_cast &>(x); case 2: reinterpret_cast &>(x) = value; return value == reinterpret_cast &>(x); case 4: reinterpret_cast &>(x) = value; return value == reinterpret_cast &>(x); case 8: reinterpret_cast &>(x) = value; return value == reinterpret_cast &>(x); default: return false; } } // Maps intrinsic runtime type category and kind values to the appropriate // instantiation of a function object template and calls it with the supplied // arguments. template