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 template <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
  30 extern "C" {
  31 std::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
  42 void 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
  53 std::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
  63 std::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
  74 void 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
  85 void 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