1//===-- lib/runtime/inquiry.cpp ---------------------------------*- 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// 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 "flang-rt/runtime/descriptor.h"
15#include "flang-rt/runtime/terminator.h"
16#include "flang-rt/runtime/tools.h"
17#include <algorithm>
18
19namespace Fortran::runtime {
20
21template <int KIND> struct RawStoreIntegerAt {
22 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
30extern "C" {
31std::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
42void 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
53std::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
63std::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
74void 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
85void 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

source code of flang-rt/lib/runtime/inquiry.cpp