Skip to content

Commit 08dfb32

Browse files
klauslermemfrob
klausler
authored and
memfrob
committed
[flang] TRANSFER() intrinsic function
API, implementation, and unit tests for the intrinsic function TRANSFER. Differential Revision: https://reviews.llvm.org/D99799
1 parent f994611 commit 08dfb32

File tree

9 files changed

+242
-32
lines changed

9 files changed

+242
-32
lines changed

‎flang/runtime/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ add_flang_library(FortranRuntime
5151
io-stmt.cpp
5252
main.cpp
5353
memory.cpp
54+
misc-intrinsic.cpp
5455
numeric.cpp
5556
reduction.cpp
5657
stat.cpp

‎flang/runtime/descriptor.cpp

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -260,6 +260,17 @@ void Descriptor::Dump(FILE *f) const {
260260
}
261261
}
262262

263+
DescriptorAddendum &DescriptorAddendum::operator=(
264+
const DescriptorAddendum &that) {
265+
derivedType_ = that.derivedType_;
266+
flags_ = that.flags_;
267+
auto lenParms{that.LenParameters()};
268+
for (std::size_t j{0}; j < lenParms; ++j) {
269+
len_[j] = that.len_[j];
270+
}
271+
return *this;
272+
}
273+
263274
std::size_t DescriptorAddendum::SizeInBytes() const {
264275
return SizeInBytes(LenParameters());
265276
}

‎flang/runtime/descriptor.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@ class DescriptorAddendum {
9393
explicit DescriptorAddendum(
9494
const typeInfo::DerivedType *dt = nullptr, std::uint64_t flags = 0)
9595
: derivedType_{dt}, flags_{flags} {}
96+
DescriptorAddendum &operator=(const DescriptorAddendum &);
9697

9798
const typeInfo::DerivedType *derivedType() const { return derivedType_; }
9899
DescriptorAddendum &set_derivedType(const typeInfo::DerivedType *dt) {

‎flang/runtime/misc-intrinsic.cpp

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
//===-- runtime/misc-intrinsic.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+
#include "misc-intrinsic.h"
10+
#include "descriptor.h"
11+
#include "terminator.h"
12+
#include <algorithm>
13+
#include <cstring>
14+
15+
namespace Fortran::runtime {
16+
extern "C" {
17+
18+
void RTNAME(Transfer)(Descriptor &result, const Descriptor &source,
19+
const Descriptor &mold, const char *sourceFile, int line) {
20+
if (mold.rank() > 0) {
21+
std::size_t moldElementBytes{mold.ElementBytes()};
22+
std::size_t elements{
23+
(source.Elements() * source.ElementBytes() + moldElementBytes - 1) /
24+
moldElementBytes};
25+
return RTNAME(TransferSize)(result, source, mold, sourceFile, line,
26+
static_cast<std::int64_t>(elements));
27+
} else {
28+
return RTNAME(TransferSize)(result, source, mold, sourceFile, line, 1);
29+
}
30+
}
31+
32+
void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
33+
const Descriptor &mold, const char *sourceFile, int line,
34+
std::int64_t size) {
35+
int rank{mold.rank() > 0 ? 1 : 0};
36+
std::size_t elementBytes{mold.ElementBytes()};
37+
result.Establish(mold.type(), elementBytes, nullptr, rank, nullptr,
38+
CFI_attribute_allocatable, mold.Addendum() != nullptr);
39+
if (rank > 0) {
40+
result.GetDimension(0).SetBounds(1, size);
41+
}
42+
if (const DescriptorAddendum * addendum{mold.Addendum()}) {
43+
*result.Addendum() = *addendum;
44+
auto &flags{result.Addendum()->flags()};
45+
flags &= ~DescriptorAddendum::StaticDescriptor;
46+
flags |= DescriptorAddendum::DoNotFinalize;
47+
}
48+
if (int stat{result.Allocate()}) {
49+
Terminator{sourceFile, line}.Crash(
50+
"TRANSFER: could not allocate memory for result; STAT=%d", stat);
51+
}
52+
char *to{result.OffsetElement<char>()};
53+
std::size_t resultBytes{size * elementBytes};
54+
const std::size_t sourceElementBytes{source.ElementBytes()};
55+
std::size_t sourceElements{source.Elements()};
56+
SubscriptValue sourceAt[maxRank];
57+
source.GetLowerBounds(sourceAt);
58+
while (resultBytes > 0 && sourceElements > 0) {
59+
std::size_t toMove{std::min(resultBytes, sourceElementBytes)};
60+
std::memcpy(to, source.Element<char>(sourceAt), toMove);
61+
to += toMove;
62+
resultBytes -= toMove;
63+
--sourceElements;
64+
source.IncrementSubscripts(sourceAt);
65+
}
66+
if (resultBytes > 0) {
67+
std::memset(to, 0, resultBytes);
68+
}
69+
}
70+
71+
} // extern "C"
72+
} // namespace Fortran::runtime

‎flang/runtime/misc-intrinsic.h

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
//===-- runtime/misc-intrinsic.h --------------------------------*- 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-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
// Miscellaneous intrinsic procedures
10+
11+
#ifndef FORTRAN_RUNTIME_MISC_INTRINSIC_H_
12+
#define FORTRAN_RUNTIME_MISC_INTRINSIC_H_
13+
14+
#include "entry-names.h"
15+
#include <cstdint>
16+
17+
namespace Fortran::runtime {
18+
19+
class Descriptor;
20+
21+
extern "C" {
22+
void RTNAME(Transfer)(Descriptor &result, const Descriptor &source,
23+
const Descriptor &mold, const char *sourceFile, int line);
24+
void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
25+
const Descriptor &mold, const char *sourceFile, int line,
26+
std::int64_t size);
27+
} // extern "C"
28+
} // namespace Fortran::runtime
29+
#endif // FORTRAN_RUNTIME_MISC_INTRINSIC_H_

‎flang/unittests/RuntimeGTest/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
add_flang_unittest(FlangRuntimeTests
22
CharacterTest.cpp
33
CrashHandlerFixture.cpp
4+
MiscIntrinsic.cpp
45
Numeric.cpp
56
NumericalFormatTest.cpp
67
Reduction.cpp

‎flang/unittests/RuntimeGTest/MiscIntrinsic.cpp

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
//===-- flang/unittests/RuntimeGTest/MiscIntrinsic.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-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#include "gtest/gtest.h"
10+
#include "tools.h"
11+
#include "../../runtime/allocatable.h"
12+
#include "../../runtime/cpp-type.h"
13+
#include "../../runtime/descriptor.h"
14+
#include "../../runtime/misc-intrinsic.h"
15+
16+
using namespace Fortran::runtime;
17+
18+
// TRANSFER examples from Fortran 2018
19+
20+
TEST(MiscIntrinsic, TransferScalar) {
21+
StaticDescriptor<2, true, 2> staticDesc[2];
22+
auto &result{staticDesc[0].descriptor()};
23+
auto source{MakeArray<TypeCategory::Integer, 4>(
24+
std::vector<int>{}, std::vector<std::int32_t>{1082130432})};
25+
auto &mold{staticDesc[1].descriptor()};
26+
mold.Establish(TypeCategory::Real, 4, nullptr, 0);
27+
RTNAME(Transfer)(result, *source, mold, __FILE__, __LINE__);
28+
EXPECT_EQ(result.rank(), 0);
29+
EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Real, 4}.raw()));
30+
EXPECT_EQ(*result.OffsetElement<float>(), 4.0);
31+
result.Destroy();
32+
}
33+
34+
TEST(MiscIntrinsic, TransferMold) {
35+
StaticDescriptor<2, true, 2> staticDesc[2];
36+
auto &result{staticDesc[0].descriptor()};
37+
auto source{MakeArray<TypeCategory::Real, 4>(
38+
std::vector<int>{3}, std::vector<float>{1.1F, 2.2F, 3.3F})};
39+
auto &mold{staticDesc[1].descriptor()};
40+
SubscriptValue extent[1]{1};
41+
mold.Establish(TypeCategory::Complex, 4, nullptr, 1, extent);
42+
RTNAME(Transfer)(result, *source, mold, __FILE__, __LINE__);
43+
EXPECT_EQ(result.rank(), 1);
44+
EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
45+
EXPECT_EQ(result.GetDimension(0).Extent(), 2);
46+
EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Complex, 4}.raw()));
47+
EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
48+
EXPECT_EQ(result.OffsetElement<float>()[1], 2.2F);
49+
EXPECT_EQ(result.OffsetElement<float>()[2], 3.3F);
50+
EXPECT_EQ(result.OffsetElement<float>()[3], 0.0F);
51+
result.Destroy();
52+
}
53+
54+
TEST(MiscIntrinsic, TransferSize) {
55+
StaticDescriptor<2, true, 2> staticDesc[2];
56+
auto &result{staticDesc[0].descriptor()};
57+
auto source{MakeArray<TypeCategory::Real, 4>(
58+
std::vector<int>{3}, std::vector<float>{1.1F, 2.2F, 3.3F})};
59+
auto &mold{staticDesc[1].descriptor()};
60+
SubscriptValue extent[1]{1};
61+
mold.Establish(TypeCategory::Complex, 4, nullptr, 1, extent);
62+
RTNAME(TransferSize)(result, *source, mold, __FILE__, __LINE__, 1);
63+
EXPECT_EQ(result.rank(), 1);
64+
EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
65+
EXPECT_EQ(result.GetDimension(0).Extent(), 1);
66+
EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Complex, 4}.raw()));
67+
EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
68+
EXPECT_EQ(result.OffsetElement<float>()[1], 2.2F);
69+
result.Destroy();
70+
}

‎flang/unittests/RuntimeGTest/Reduction.cpp

Lines changed: 1 addition & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88

99
#include "../../runtime/reduction.h"
1010
#include "gtest/gtest.h"
11+
#include "tools.h"
1112
#include "../../runtime/allocatable.h"
1213
#include "../../runtime/cpp-type.h"
1314
#include "../../runtime/descriptor.h"
@@ -20,38 +21,6 @@
2021
using namespace Fortran::runtime;
2122
using Fortran::common::TypeCategory;
2223

23-
template <typename A>
24-
static void StoreElement(void *p, const A &x, std::size_t bytes) {
25-
std::memcpy(p, &x, bytes);
26-
}
27-
28-
template <typename CHAR>
29-
static void StoreElement(
30-
void *p, const std::basic_string<CHAR> &str, std::size_t bytes) {
31-
ASSERT_LE(bytes, sizeof(CHAR) * str.size());
32-
std::memcpy(p, str.data(), bytes);
33-
}
34-
35-
template <TypeCategory CAT, int KIND, typename A>
36-
static OwningPtr<Descriptor> MakeArray(const std::vector<int> &shape,
37-
const std::vector<A> &data, std::size_t elemLen = KIND) {
38-
auto rank{static_cast<int>(shape.size())};
39-
auto result{Descriptor::Create(TypeCode{CAT, KIND}, elemLen, nullptr, rank,
40-
nullptr, CFI_attribute_allocatable)};
41-
for (int j{0}; j < rank; ++j) {
42-
result->GetDimension(j).SetBounds(1, shape[j]);
43-
}
44-
int stat{result->Allocate()};
45-
EXPECT_EQ(stat, 0) << stat;
46-
EXPECT_LE(data.size(), result->Elements());
47-
char *p{result->OffsetElement<char>()};
48-
for (const auto &x : data) {
49-
StoreElement(p, x, elemLen);
50-
p += elemLen;
51-
}
52-
return result;
53-
}
54-
5524
TEST(Reductions, SumInt4) {
5625
auto array{MakeArray<TypeCategory::Integer, 4>(
5726
std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};

‎flang/unittests/RuntimeGTest/tools.h

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
//===-- flang/unittests/RuntimeGTest/tools.h --------------------*- 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-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#ifndef FORTRAN_UNITTESTS_RUNTIME_TOOLS_H_
10+
#define FORTRAN_UNITTESTS_RUNTIME_TOOLS_H_
11+
12+
#include "gtest/gtest.h"
13+
#include "../../runtime/allocatable.h"
14+
#include "../../runtime/cpp-type.h"
15+
#include "../../runtime/descriptor.h"
16+
#include "../../runtime/type-code.h"
17+
#include <cstdint>
18+
#include <cstring>
19+
#include <vector>
20+
21+
namespace Fortran::runtime {
22+
23+
template <typename A>
24+
static void StoreElement(void *p, const A &x, std::size_t bytes) {
25+
std::memcpy(p, &x, bytes);
26+
}
27+
28+
template <typename CHAR>
29+
static void StoreElement(
30+
void *p, const std::basic_string<CHAR> &str, std::size_t bytes) {
31+
ASSERT_LE(bytes, sizeof(CHAR) * str.size());
32+
std::memcpy(p, str.data(), bytes);
33+
}
34+
35+
template <TypeCategory CAT, int KIND, typename A>
36+
static OwningPtr<Descriptor> MakeArray(const std::vector<int> &shape,
37+
const std::vector<A> &data, std::size_t elemLen = KIND) {
38+
auto rank{static_cast<int>(shape.size())};
39+
auto result{Descriptor::Create(TypeCode{CAT, KIND}, elemLen, nullptr, rank,
40+
nullptr, CFI_attribute_allocatable)};
41+
for (int j{0}; j < rank; ++j) {
42+
result->GetDimension(j).SetBounds(1, shape[j]);
43+
}
44+
int stat{result->Allocate()};
45+
EXPECT_EQ(stat, 0) << stat;
46+
EXPECT_LE(data.size(), result->Elements());
47+
char *p{result->OffsetElement<char>()};
48+
for (A x : data) {
49+
StoreElement(p, x, elemLen);
50+
p += elemLen;
51+
}
52+
return result;
53+
}
54+
55+
} // namespace Fortran::runtime
56+
#endif // FORTRAN_UNITTESTS_RUNTIME_TOOLS_H_

0 commit comments

Comments
 (0)