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 extern "C" {
22 std::int64_t RTNAME(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 
33 void RTNAME(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 
58 std::int64_t RTNAME(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 
68 std::int64_t RTNAME(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