1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
//===-- runtime/inquiry.cpp --------------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
// Implements the inquiry intrinsic functions of Fortran 2018 that
// inquire about shape information of arrays -- LBOUND and SIZE.
#include "flang/Runtime/inquiry.h"
#include "copy.h"
#include "terminator.h"
#include "tools.h"
#include "flang/Runtime/descriptor.h"
#include <algorithm>
namespace Fortran::runtime {
template <int KIND> struct RawStoreIntegerAt {
RT_API_ATTRS void operator()(
void *contiguousIntegerArray, std::size_t at, std::int64_t value) const {
reinterpret_cast<Fortran::runtime::CppTypeFor<
Fortran::common::TypeCategory::Integer, KIND> *>(
contiguousIntegerArray)[at] = value;
}
};
extern "C" {
std::int64_t RTDEF(LboundDim)(
const Descriptor &array, int dim, const char *sourceFile, int line) {
if (dim < 1 || dim > array.rank()) {
Terminator terminator{sourceFile, line};
terminator.Crash(
"SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
}
const Dimension &dimension{array.GetDimension(dim - 1)};
return static_cast<std::int64_t>(dimension.LowerBound());
}
void RTDEF(Ubound)(void *result, const Descriptor &array, int kind,
const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
INTERNAL_CHECK(array.rank() <= common::maxRank);
for (SubscriptValue i{0}; i < array.rank(); ++i) {
const Dimension &dimension{array.GetDimension(i)};
Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
kind, terminator, result, i, dimension.UpperBound());
}
}
std::int64_t RTDEF(Size)(
const Descriptor &array, const char *sourceFile, int line) {
std::int64_t result{1};
for (int i = 0; i < array.rank(); ++i) {
const Dimension &dimension{array.GetDimension(i)};
result *= dimension.Extent();
}
return result;
}
std::int64_t RTDEF(SizeDim)(
const Descriptor &array, int dim, const char *sourceFile, int line) {
if (dim < 1 || dim > array.rank()) {
Terminator terminator{sourceFile, line};
terminator.Crash(
"SIZE: bad DIM=%d for ARRAY with rank=%d", dim, array.rank());
}
const Dimension &dimension{array.GetDimension(dim - 1)};
return static_cast<std::int64_t>(dimension.Extent());
}
void RTDEF(Shape)(void *result, const Descriptor &array, int kind,
const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
INTERNAL_CHECK(array.rank() <= common::maxRank);
for (SubscriptValue i{0}; i < array.rank(); ++i) {
const Dimension &dimension{array.GetDimension(i)};
Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
kind, terminator, result, i, dimension.Extent());
}
}
void RTDEF(Lbound)(void *result, const Descriptor &array, int kind,
const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
INTERNAL_CHECK(array.rank() <= common::maxRank);
for (SubscriptValue i{0}; i < array.rank(); ++i) {
const Dimension &dimension{array.GetDimension(i)};
Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
kind, terminator, result, i, dimension.LowerBound());
}
}
} // extern "C"
} // namespace Fortran::runtime
|
