98 lines · cpp
1//===-- lib/runtime/inquiry.cpp ---------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9// Implements the inquiry intrinsic functions of Fortran 2018 that10// inquire about shape information of arrays -- LBOUND and SIZE.11 12#include "flang/Runtime/inquiry.h"13#include "copy.h"14#include "flang-rt/runtime/descriptor.h"15#include "flang-rt/runtime/terminator.h"16#include "flang-rt/runtime/tools.h"17#include <algorithm>18 19namespace Fortran::runtime {20 21template <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 30extern "C" {31std::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 42void 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 53std::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 63std::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 74void 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 85void 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::runtime98