[flang][runtime] add SHAPE runtime interface (#94702)

Add SHAPE runtime API (will be used for assumed-rank, lowering is
generating other cases inline).

I tried to make it in a way were there is no dynamic allocation in the
runtime/deallocation expected to be inserted by inline code for arrays
that we know are small (lowering will just always stack allocate a rank
15 array to avoid dynamic stack allocation or heap allocation).
This commit is contained in:
jeanPerier 2024-06-07 17:38:11 +02:00 committed by GitHub
parent 97b12df2cc
commit b01ac5137c
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 57 additions and 2 deletions

View File

@ -23,13 +23,18 @@ extern "C" {
std::int64_t RTDECL(LboundDim)(const Descriptor &array, int dim,
const char *sourceFile = nullptr, int line = 0);
void RTDECL(Ubound)(Descriptor &result, const Descriptor &array, int kind,
const char *sourceFile = nullptr, int line = 0);
void RTDECL(Shape)(void *result, const Descriptor &array, int kind);
std::int64_t RTDECL(Size)(
const Descriptor &array, const char *sourceFile = nullptr, int line = 0);
std::int64_t RTDECL(SizeDim)(const Descriptor &array, int dim,
const char *sourceFile = nullptr, int line = 0);
void RTDECL(Ubound)(Descriptor &result, const Descriptor &array, int kind,
const char *sourceFile = nullptr, int line = 0);
} // extern "C"
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_INQUIRY_H_

View File

@ -18,6 +18,15 @@
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) {
@ -76,5 +85,15 @@ std::int64_t RTDEF(SizeDim)(
return static_cast<std::int64_t>(dimension.Extent());
}
void RTDEF(Shape)(void *result, const Descriptor &array, int kind) {
Terminator terminator{__FILE__, __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());
}
}
} // extern "C"
} // namespace Fortran::runtime

View File

@ -76,3 +76,34 @@ TEST(Inquiry, Size) {
EXPECT_EQ(RTNAME(SizeDim)(*array, 2, __FILE__, __LINE__), std::int64_t{3});
EXPECT_EQ(RTNAME(Size)(*array, __FILE__, __LINE__), std::int64_t{6});
}
TEST(Inquiry, Shape) {
// ARRAY 1 3 5
// 2 4 6
auto array{MakeArray<TypeCategory::Integer, 4>(
std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
// SHAPE(ARRAY, KIND=1)
auto int8Result{
MakeArray<TypeCategory::Integer, 1>(std::vector<int>{array->rank()},
std::vector<std::int8_t>(array->rank(), 0))};
RTNAME(Shape)(int8Result->raw().base_addr, *array, /*KIND=*/1);
EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(0), 2);
EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(1), 3);
// SHAPE(ARRAY, KIND=4)
auto int32Result{
MakeArray<TypeCategory::Integer, 4>(std::vector<int>{array->rank()},
std::vector<std::int32_t>(array->rank(), 0))};
RTNAME(Shape)(int32Result->raw().base_addr, *array, /*KIND=*/4);
EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(0), 2);
EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(1), 3);
// SHAPE(ARRAY, KIND=8)
auto int64Result{
MakeArray<TypeCategory::Integer, 8>(std::vector<int>{array->rank()},
std::vector<std::int64_t>(array->rank(), 0))};
RTNAME(Shape)(int64Result->raw().base_addr, *array, /*KIND=*/8);
EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(0), 2);
EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(1), 3);
}