flang/runtime/inquiry.cpp

   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