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