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
19namespace Fortran::runtime {
20
21extern "C" {
22std::int64_t RTDEF(LboundDim)(
23 const Descriptor &array, int dim, const char *sourceFile, int line) {
24 if (dim < 1 || dim > array.rank()) {
25 Terminator terminator{sourceFile, line};
26 terminator.Crash(
27 "SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
28 }
29 const Dimension &dimension{array.GetDimension(dim - 1)};
30 return static_cast<std::int64_t>(dimension.LowerBound());
31}
32
33void RTDEF(Ubound)(Descriptor &result, const Descriptor &array, int kind,
34 const char *sourceFile, int line) {
35 SubscriptValue extent[1]{array.rank()};
36 result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent,
37 CFI_attribute_allocatable);
38 // The array returned by UBOUND has a lower bound of 1 and an extent equal to
39 // the rank of its input array.
40 result.GetDimension(0).SetBounds(1, array.rank());
41 Terminator terminator{sourceFile, line};
42 if (int stat{result.Allocate()}) {
43 terminator.Crash(
44 "UBOUND: could not allocate memory for result; STAT=%d", stat);
45 }
46 auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
47 Fortran::runtime::ApplyIntegerKind<StoreIntegerAt, void>(
48 kind, terminator, result, atIndex, value);
49 };
50
51 INTERNAL_CHECK(result.rank() == 1);
52 for (SubscriptValue i{0}; i < array.rank(); ++i) {
53 const Dimension &dimension{array.GetDimension(i)};
54 storeIntegerAt(i, dimension.UpperBound());
55 }
56}
57
58std::int64_t RTDEF(Size)(
59 const Descriptor &array, const char *sourceFile, int line) {
60 std::int64_t result{1};
61 for (int i = 0; i < array.rank(); ++i) {
62 const Dimension &dimension{array.GetDimension(i)};
63 result *= dimension.Extent();
64 }
65 return result;
66}
67
68std::int64_t RTDEF(SizeDim)(
69 const Descriptor &array, int dim, const char *sourceFile, int line) {
70 if (dim < 1 || dim > array.rank()) {
71 Terminator terminator{sourceFile, line};
72 terminator.Crash(
73 "SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
74 }
75 const Dimension &dimension{array.GetDimension(dim - 1)};
76 return static_cast<std::int64_t>(dimension.Extent());
77}
78
79} // extern "C"
80} // namespace Fortran::runtime
81

source code of flang/runtime/inquiry.cpp