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