blob: 1b988d994eb65932ac4fd57458e24c07fe0540e5 [file] [log] [blame]
peter klauslerfae12a02020-01-24 00:10:001//===-- 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_
peter klauslerf7be2512020-01-24 00:59:2711
peter klauslere372e0f2021-03-31 16:14:0812#include "cpp-type.h"
13#include "descriptor.h"
peter klauslerfae12a02020-01-24 00:10:0014#include "memory.h"
peter klauslere372e0f2021-03-31 16:14:0815#include "terminator.h"
peter klauslerf7be2512020-01-24 00:59:2716#include <functional>
17#include <map>
18#include <type_traits>
19
peter klauslerfae12a02020-01-24 00:10:0020namespace Fortran::runtime {
21
22class Terminator;
23
peter klausler675ad1b2020-08-03 18:35:2924std::size_t TrimTrailingSpaces(const char *, std::size_t);
25
peter klausler95696d52020-02-05 00:55:4526OwningPtr<char> SaveDefaultCharacter(
27 const char *, std::size_t, const Terminator &);
peter klauslerfae12a02020-01-24 00:10:0028
29// For validating and recognizing default CHARACTER values in a
30// case-insensitive manner. Returns the zero-based index into the
31// null-terminated array of upper-case possibilities when the value is valid,
32// or -1 when it has no match.
33int IdentifyValue(
34 const char *value, std::size_t length, const char *possibilities[]);
peter klauslerf7be2512020-01-24 00:59:2735
peter klausler3b635712020-02-13 22:41:5636// Truncates or pads as necessary
37void ToFortranDefaultCharacter(
38 char *to, std::size_t toLength, const char *from);
peter klauslere372e0f2021-03-31 16:14:0839
40// Utility for dealing with elemental LOGICAL arguments
41inline bool IsLogicalElementTrue(
42 const Descriptor &logical, const SubscriptValue at[]) {
43 // A LOGICAL value is false if and only if all of its bytes are zero.
44 const char *p{logical.Element<char>(at)};
45 for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) {
46 if (*p) {
47 return true;
48 }
49 }
50 return false;
51}
52
53// Check array conformability; a scalar 'x' conforms. Crashes on error.
54void CheckConformability(const Descriptor &to, const Descriptor &x,
55 Terminator &, const char *funcName, const char *toName,
56 const char *fromName);
57
58// Validate a KIND= argument
59void CheckIntegerKind(Terminator &, int kind, const char *intrinsic);
60
61template <typename TO, typename FROM>
62inline void PutContiguousConverted(TO *to, FROM *from, std::size_t count) {
63 while (count-- > 0) {
64 *to++ = *from++;
65 }
66}
67
68static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
69 switch (bytes) {
70 case 1:
71 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
72 case 2:
73 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
74 case 4:
75 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
76 case 8:
77 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
78 default:
79 Terminator{__FILE__, __LINE__}.Crash(
80 "GetInt64: no case for %zd bytes", bytes);
81 }
82}
83
84template <typename INT>
85inline bool SetInteger(INT &x, int kind, std::int64_t value) {
86 switch (kind) {
87 case 1:
88 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
89 return true;
90 case 2:
91 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x) = value;
92 return true;
93 case 4:
94 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x) = value;
95 return true;
96 case 8:
97 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
98 return true;
99 default:
100 return false;
101 }
102}
103
Tim Keith1f879002020-03-29 04:00:16104} // namespace Fortran::runtime
105#endif // FORTRAN_RUNTIME_TOOLS_H_