1 //===-- runtime/inquiry.cpp --------------------------------------===//
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 // Implements the inquiry intrinsic functions of Fortran 2018 that
10 // inquire about shape information of arrays -- LBOUND and SIZE.
11
12 #include "flang/Runtime/inquiry.h"
13 #include "copy.h"
14 #include "terminator.h"
15 #include "tools.h"
16 #include "flang/Runtime/descriptor.h"
17 #include <algorithm>
18
19 namespace Fortran::runtime {
20
21 template <int KIND> struct RawStoreIntegerAt {
operator ()Fortran::runtime::RawStoreIntegerAt22 RT_API_ATTRS void operator()(
23 void *contiguousIntegerArray, std::size_t at, std::int64_t value) const {
24 reinterpret_cast<Fortran::runtime::CppTypeFor<
25 Fortran::common::TypeCategory::Integer, KIND> *>(
26 contiguousIntegerArray)[at] = value;
27 }
28 };
29
30 extern "C" {
RTDEF(LboundDim)31 std::int64_t RTDEF(LboundDim)(
32 const Descriptor &array, int dim, const char *sourceFile, int line) {
33 if (dim < 1 || dim > array.rank()) {
34 Terminator terminator{sourceFile, line};
35 terminator.Crash(
36 "SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
37 }
38 const Dimension &dimension{array.GetDimension(dim - 1)};
39 return static_cast<std::int64_t>(dimension.LowerBound());
40 }
41
RTDEF(Ubound)42 void RTDEF(Ubound)(void *result, const Descriptor &array, int kind,
43 const char *sourceFile, int line) {
44 Terminator terminator{sourceFile, line};
45 INTERNAL_CHECK(array.rank() <= common::maxRank);
46 for (SubscriptValue i{0}; i < array.rank(); ++i) {
47 const Dimension &dimension{array.GetDimension(i)};
48 Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
49 kind, terminator, result, i, dimension.UpperBound());
50 }
51 }
52
RTDEF(Size)53 std::int64_t RTDEF(Size)(
54 const Descriptor &array, const char *sourceFile, int line) {
55 std::int64_t result{1};
56 for (int i = 0; i < array.rank(); ++i) {
57 const Dimension &dimension{array.GetDimension(i)};
58 result *= dimension.Extent();
59 }
60 return result;
61 }
62
RTDEF(SizeDim)63 std::int64_t RTDEF(SizeDim)(
64 const Descriptor &array, int dim, const char *sourceFile, int line) {
65 if (dim < 1 || dim > array.rank()) {
66 Terminator terminator{sourceFile, line};
67 terminator.Crash(
68 "SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
69 }
70 const Dimension &dimension{array.GetDimension(dim - 1)};
71 return static_cast<std::int64_t>(dimension.Extent());
72 }
73
RTDEF(Shape)74 void RTDEF(Shape)(void *result, const Descriptor &array, int kind,
75 const char *sourceFile, int line) {
76 Terminator terminator{sourceFile, line};
77 INTERNAL_CHECK(array.rank() <= common::maxRank);
78 for (SubscriptValue i{0}; i < array.rank(); ++i) {
79 const Dimension &dimension{array.GetDimension(i)};
80 Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
81 kind, terminator, result, i, dimension.Extent());
82 }
83 }
84
RTDEF(Lbound)85 void RTDEF(Lbound)(void *result, const Descriptor &array, int kind,
86 const char *sourceFile, int line) {
87 Terminator terminator{sourceFile, line};
88 INTERNAL_CHECK(array.rank() <= common::maxRank);
89 for (SubscriptValue i{0}; i < array.rank(); ++i) {
90 const Dimension &dimension{array.GetDimension(i)};
91 Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
92 kind, terminator, result, i, dimension.LowerBound());
93 }
94 }
95
96 } // extern "C"
97 } // namespace Fortran::runtime
98