[flang-commits] [flang] ad424cf - [flang] Runtime API for data pointers
peter klausler via flang-commits
flang-commits at lists.llvm.org
Mon Jul 19 08:23:17 PDT 2021
Author: peter klausler
Date: 2021-07-19T08:23:06-07:00
New Revision: ad424cf1ed2a191b3e93f60ca591104dbf4b79a2
URL: https://github.com/llvm/llvm-project/commit/ad424cf1ed2a191b3e93f60ca591104dbf4b79a2
DIFF: https://github.com/llvm/llvm-project/commit/ad424cf1ed2a191b3e93f60ca591104dbf4b79a2.diff
LOG: [flang] Runtime API for data pointers
Define and implement an API for use by lowering to
implement operations on pointers.
Differential Revision: https://reviews.llvm.org/D106170
Added:
flang/runtime/pointer.cpp
flang/runtime/pointer.h
Modified:
flang/runtime/CMakeLists.txt
flang/runtime/allocatable.cpp
flang/runtime/allocatable.h
flang/runtime/descriptor.cpp
flang/runtime/descriptor.h
flang/runtime/misc-intrinsic.cpp
flang/test/Semantics/offsets01.f90
Removed:
################################################################################
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 1f7e3d14728a4..69f68e4360401 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -62,6 +62,7 @@ add_flang_library(FortranRuntime
numeric.cpp
random.cpp
reduction.cpp
+ pointer.cpp
product.cpp
stat.cpp
stop.cpp
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index f14122948f5e9..ffdee674a9eff 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -53,6 +53,20 @@ void RTNAME(AllocatableSetBounds)(Descriptor &descriptor, int zeroBasedDim,
// The byte strides are computed when the object is allocated.
}
+void RTNAME(AllocatableSetDerivedLength)(
+ Descriptor &descriptor, int which, SubscriptValue x) {
+ DescriptorAddendum *addendum{descriptor.Addendum()};
+ INTERNAL_CHECK(addendum != nullptr);
+ addendum->SetLenParameterValue(which, x);
+}
+
+void RTNAME(AllocatableApplyMold)(
+ Descriptor &descriptor, const Descriptor &mold) {
+ descriptor = mold;
+ descriptor.set_base_addr(nullptr);
+ descriptor.raw().attribute = CFI_attribute_allocatable;
+}
+
int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
@@ -63,6 +77,7 @@ int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
return ReturnError(terminator, StatBaseNotNull, errMsg, hasStat);
}
return ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat);
+ // TODO: default component initialization
}
int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
@@ -76,5 +91,7 @@ int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
}
return ReturnError(terminator, descriptor.Deallocate(), errMsg, hasStat);
}
+
+// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
}
} // namespace Fortran::runtime
diff --git a/flang/runtime/allocatable.h b/flang/runtime/allocatable.h
index 85334cbfb0bc6..cd2c566fe7765 100644
--- a/flang/runtime/allocatable.h
+++ b/flang/runtime/allocatable.h
@@ -10,14 +10,12 @@
// to manipulate and query allocatable variables, dummy arguments, & components.
#ifndef FORTRAN_RUNTIME_ALLOCATABLE_H_
#define FORTRAN_RUNTIME_ALLOCATABLE_H_
+
#include "descriptor.h"
#include "entry-names.h"
-namespace Fortran::runtime::typeInfo {
-class DerivedType;
-}
-
namespace Fortran::runtime {
+
extern "C" {
// Initializes the descriptor for an allocatable of intrinsic or derived type.
@@ -55,7 +53,7 @@ void RTNAME(AllocatableApplyMold)(Descriptor &, const Descriptor &mold);
void RTNAME(AllocatableSetBounds)(
Descriptor &, int zeroBasedDim, SubscriptValue lower, SubscriptValue upper);
-// The upper bound is ignored for the last codimension.
+// The upper cobound is ignored for the last codimension.
void RTNAME(AllocatableSetCoBounds)(Descriptor &, int zeroBasedCoDim,
SubscriptValue lower, SubscriptValue upper = 0);
diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
index ba97b876eceb8..0103f46ad33f2 100644
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -160,9 +160,6 @@ int Descriptor::Deallocate(bool finalize) {
void Descriptor::Destroy(bool finalize) const {
if (const DescriptorAddendum * addendum{Addendum()}) {
if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
- if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
- finalize = false;
- }
runtime::Destroy(*this, finalize, *dt);
}
}
@@ -278,7 +275,6 @@ void Descriptor::Dump(FILE *f) const {
DescriptorAddendum &DescriptorAddendum::operator=(
const DescriptorAddendum &that) {
derivedType_ = that.derivedType_;
- flags_ = that.flags_;
auto lenParms{that.LenParameters()};
for (std::size_t j{0}; j < lenParms; ++j) {
len_[j] = that.len_[j];
@@ -297,8 +293,10 @@ std::size_t DescriptorAddendum::LenParameters() const {
void DescriptorAddendum::Dump(FILE *f) const {
std::fprintf(
- f, " derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
- std::fprintf(f, " flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
- // TODO: LEN parameter values
+ f, " derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
+ std::size_t lenParms{LenParameters()};
+ for (std::size_t j{0}; j < lenParms; ++j) {
+ std::fprintf(f, " len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
+ }
}
} // namespace Fortran::runtime
diff --git a/flang/runtime/descriptor.h b/flang/runtime/descriptor.h
index e5cf0d22b3c38..88e306c5f5908 100644
--- a/flang/runtime/descriptor.h
+++ b/flang/runtime/descriptor.h
@@ -83,16 +83,8 @@ class Dimension {
// array is determined by derivedType_->LenParameters().
class DescriptorAddendum {
public:
- enum Flags {
- StaticDescriptor = 0x001,
- ImplicitAllocatable = 0x002, // compiler-created allocatable
- DoNotFinalize = 0x004, // compiler temporary
- Target = 0x008, // TARGET attribute
- };
-
- explicit DescriptorAddendum(
- const typeInfo::DerivedType *dt = nullptr, std::uint64_t flags = 0)
- : derivedType_{dt}, flags_{flags} {}
+ explicit DescriptorAddendum(const typeInfo::DerivedType *dt = nullptr)
+ : derivedType_{dt} {}
DescriptorAddendum &operator=(const DescriptorAddendum &);
const typeInfo::DerivedType *derivedType() const { return derivedType_; }
@@ -100,8 +92,6 @@ class DescriptorAddendum {
derivedType_ = dt;
return *this;
}
- std::uint64_t &flags() { return flags_; }
- const std::uint64_t &flags() const { return flags_; }
std::size_t LenParameters() const;
@@ -123,7 +113,6 @@ class DescriptorAddendum {
private:
const typeInfo::DerivedType *derivedType_;
- std::uint64_t flags_{0};
typeInfo::TypeParameterValue len_[1]; // must be the last component
// The LEN type parameter values can also include captured values of
// specification expressions that were used for bounds and for LEN type
@@ -145,12 +134,6 @@ class Descriptor {
// Create() static member functions otherwise to dynamically allocate a
// descriptor.
- Descriptor() {
- // Minimal initialization to prevent the destructor from running amuck
- // later if the descriptor is never established.
- raw_.base_addr = nullptr;
- raw_.f18Addendum = false;
- }
Descriptor(const Descriptor &);
~Descriptor();
Descriptor &operator=(const Descriptor &);
@@ -359,8 +342,6 @@ class alignas(Descriptor) StaticDescriptor {
static constexpr std::size_t byteSize{
Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
- StaticDescriptor() { new (storage_) Descriptor{}; }
-
~StaticDescriptor() { descriptor().~Descriptor(); }
Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
@@ -382,7 +363,7 @@ class alignas(Descriptor) StaticDescriptor {
}
private:
- char storage_[byteSize];
+ char storage_[byteSize]{};
};
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_DESCRIPTOR_H_
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index 7b4fa5fa3a31e..3d77ce7a55517 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -41,9 +41,6 @@ void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
}
if (const DescriptorAddendum * addendum{mold.Addendum()}) {
*result.Addendum() = *addendum;
- auto &flags{result.Addendum()->flags()};
- flags &= ~DescriptorAddendum::StaticDescriptor;
- flags |= DescriptorAddendum::DoNotFinalize;
}
if (int stat{result.Allocate()}) {
Terminator{sourceFile, line}.Crash(
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
new file mode 100644
index 0000000000000..6f34feb049ec6
--- /dev/null
+++ b/flang/runtime/pointer.cpp
@@ -0,0 +1,160 @@
+//===-- runtime/pointer.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
+//
+//===----------------------------------------------------------------------===//
+
+#include "pointer.h"
+#include "stat.h"
+#include "terminator.h"
+#include "tools.h"
+
+namespace Fortran::runtime {
+extern "C" {
+
+void RTNAME(PointerNullifyIntrinsic)(Descriptor &pointer, TypeCategory category,
+ int kind, int rank, int corank) {
+ INTERNAL_CHECK(corank == 0);
+ pointer.Establish(TypeCode{category, kind},
+ Descriptor::BytesFor(category, kind), nullptr, rank, nullptr,
+ CFI_attribute_pointer);
+}
+
+void RTNAME(PointerNullifyCharacter)(Descriptor &pointer, SubscriptValue length,
+ int kind, int rank, int corank) {
+ INTERNAL_CHECK(corank == 0);
+ pointer.Establish(
+ kind, length, nullptr, rank, nullptr, CFI_attribute_pointer);
+}
+
+void RTNAME(PointerNullifyDerived)(Descriptor &pointer,
+ const typeInfo::DerivedType &derivedType, int rank, int corank) {
+ INTERNAL_CHECK(corank == 0);
+ pointer.Establish(derivedType, nullptr, rank, nullptr, CFI_attribute_pointer);
+}
+
+void RTNAME(PointerSetBounds)(Descriptor &pointer, int zeroBasedDim,
+ SubscriptValue lower, SubscriptValue upper) {
+ INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < pointer.rank());
+ pointer.GetDimension(zeroBasedDim).SetBounds(lower, upper);
+ // The byte strides are computed when the pointer is allocated.
+}
+
+// TODO: PointerSetCoBounds
+
+void RTNAME(PointerSetDerivedLength)(
+ Descriptor &pointer, int which, SubscriptValue x) {
+ DescriptorAddendum *addendum{pointer.Addendum()};
+ INTERNAL_CHECK(addendum != nullptr);
+ addendum->SetLenParameterValue(which, x);
+}
+
+void RTNAME(PointerApplyMold)(Descriptor &pointer, const Descriptor &mold) {
+ pointer = mold;
+ pointer.set_base_addr(nullptr);
+ pointer.raw().attribute = CFI_attribute_pointer;
+}
+
+void RTNAME(PointerAssociateScalar)(Descriptor &pointer, void *target) {
+ pointer.set_base_addr(target);
+}
+
+void RTNAME(PointerAssociate)(Descriptor &pointer, const Descriptor &target) {
+ pointer = target;
+ pointer.raw().attribute = CFI_attribute_pointer;
+}
+
+void RTNAME(PointerAssociateLowerBounds)(Descriptor &pointer,
+ const Descriptor &target, const Descriptor &lowerBounds) {
+ pointer = target;
+ pointer.raw().attribute = CFI_attribute_pointer;
+ int rank{pointer.rank()};
+ Terminator terminator{__FILE__, __LINE__};
+ std::size_t boundElementBytes{lowerBounds.ElementBytes()};
+ for (int j{0}; j < rank; ++j) {
+ pointer.GetDimension(j).SetLowerBound(
+ GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
+ boundElementBytes, terminator));
+ }
+}
+
+void RTNAME(PointerAssociateRemapping)(Descriptor &pointer,
+ const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
+ int sourceLine) {
+ pointer = target;
+ pointer.raw().attribute = CFI_attribute_pointer;
+ int rank{pointer.rank()};
+ Terminator terminator{sourceFile, sourceLine};
+ SubscriptValue byteStride{/*captured from first dimension*/};
+ std::size_t boundElementBytes{bounds.ElementBytes()};
+ for (int j{0}; j < rank; ++j) {
+ auto &dim{pointer.GetDimension(j)};
+ dim.SetBounds(GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j),
+ boundElementBytes, terminator),
+ GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j + 1),
+ boundElementBytes, terminator));
+ if (j == 0) {
+ byteStride = dim.ByteStride();
+ } else {
+ dim.SetByteStride(byteStride);
+ byteStride *= dim.Extent();
+ }
+ }
+ if (pointer.Elements() > target.Elements()) {
+ terminator.Crash("PointerAssociateRemapping: too many elements in remapped "
+ "pointer (%zd > %zd)",
+ pointer.Elements(), target.Elements());
+ }
+}
+
+int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat,
+ const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ if (!pointer.IsPointer()) {
+ return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
+ }
+ return ReturnError(terminator, pointer.Allocate(), errMsg, hasStat);
+ // TODO: default component initialization
+}
+
+int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
+ const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ if (!pointer.IsPointer()) {
+ return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
+ }
+ if (!pointer.IsAllocated()) {
+ return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
+ }
+ return ReturnError(terminator, pointer.Deallocate(), errMsg, hasStat);
+}
+
+bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {
+ return pointer.raw().base_addr != nullptr;
+}
+
+bool RTNAME(PointerIsAssociatedWith)(
+ const Descriptor &pointer, const Descriptor &target) {
+ int rank{pointer.rank()};
+ if (pointer.raw().base_addr != target.raw().base_addr ||
+ pointer.ElementBytes() != target.ElementBytes() ||
+ rank != target.rank()) {
+ return false;
+ }
+ for (int j{0}; j < rank; ++j) {
+ const Dimension &pDim{pointer.GetDimension(j)};
+ const Dimension &tDim{target.GetDimension(j)};
+ if (pDim.Extent() != tDim.Extent() ||
+ pDim.ByteStride() != tDim.ByteStride()) {
+ return false;
+ }
+ }
+ return true;
+}
+
+// TODO: PointerCheckLengthParameter, PointerAllocateSource
+
+} // extern "C"
+} // namespace Fortran::runtime
diff --git a/flang/runtime/pointer.h b/flang/runtime/pointer.h
new file mode 100644
index 0000000000000..838fde263eb12
--- /dev/null
+++ b/flang/runtime/pointer.h
@@ -0,0 +1,112 @@
+//===-- runtime/pointer.h ---------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Defines APIs for Fortran runtime library support of code generated
+// to manipulate and query data pointers.
+
+#ifndef FORTRAN_RUNTIME_POINTER_H_
+#define FORTRAN_RUNTIME_POINTER_H_
+
+#include "descriptor.h"
+#include "entry-names.h"
+
+namespace Fortran::runtime {
+extern "C" {
+
+// Data pointer initialization for NULLIFY(), "p=>NULL()`, & for ALLOCATE().
+
+// Initializes a pointer to a disassociated state for NULLIFY() or "p=>NULL()".
+void RTNAME(PointerNullifyIntrinsic)(
+ Descriptor &, TypeCategory, int kind, int rank = 0, int corank = 0);
+void RTNAME(PointerNullifyCharacter)(Descriptor &, SubscriptValue length = 0,
+ int kind = 1, int rank = 0, int corank = 0);
+void RTNAME(PointerNullifyDerived)(
+ Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
+
+// Explicitly sets the bounds of an initialized disassociated pointer.
+// The upper cobound is ignored for the last codimension.
+void RTNAME(PointerSetBounds)(
+ Descriptor &, int zeroBasedDim, SubscriptValue lower, SubscriptValue upper);
+void RTNAME(PointerSetCoBounds)(Descriptor &, int zeroBasedCoDim,
+ SubscriptValue lower, SubscriptValue upper = 0);
+
+// Length type parameters are indexed in declaration order; i.e., 0 is the
+// first length type parameter in the deepest base type. (Not for use
+// with CHARACTER; see above.)
+void RTNAME(PointerSetDerivedLength)(Descriptor &, int which, SubscriptValue);
+
+// For MOLD= allocation: acquires information from another descriptor
+// to initialize a null data pointer.
+void RTNAME(PointerApplyMold)(Descriptor &, const Descriptor &mold);
+
+// Data pointer association for "p=>TARGET"
+
+// Associates a scalar pointer with a simple scalar target.
+void RTNAME(PointerAssociateScalar)(Descriptor &, void *);
+
+// Associates a pointer with a target of the same rank, possibly with new lower
+// bounds, which are passed in a vector whose length must equal the rank.
+void RTNAME(PointerAssociate)(Descriptor &, const Descriptor &target);
+void RTNAME(PointerAssociateLowerBounds)(
+ Descriptor &, const Descriptor &target, const Descriptor &lowerBounds);
+
+// Associates a pointer with a target with bounds remapping. The target must be
+// simply contiguous &/or of rank 1. The bounds constitute a [2,newRank]
+// integer array whose columns are [lower bound, upper bound] on each dimension.
+void RTNAME(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
+ const Descriptor &bounds, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+
+// Data pointer allocation and deallocation
+
+// When an explicit type-spec appears in an ALLOCATE statement for an
+// pointer with an explicit (non-deferred) length type paramater for
+// a derived type or CHARACTER value, the explicit value has to match
+// the length type parameter's value. This API checks that requirement.
+// Returns 0 for success, or the STAT= value on failure with hasStat==true.
+int RTNAME(PointerCheckLengthParameter)(Descriptor &,
+ int which /* 0 for CHARACTER length */, SubscriptValue other,
+ bool hasStat = false, const Descriptor *errMsg = nullptr,
+ const char *sourceFile = nullptr, int sourceLine = 0);
+
+// Allocates a data pointer. Its descriptor must have been initialized
+// and its bounds and length type parameters set. It need not be disassociated.
+// On failure, if hasStat is true, returns a nonzero error code for
+// STAT= and (if present) fills in errMsg; if hasStat is false, the
+// image is terminated. On success, leaves errMsg alone and returns zero.
+// Successfully allocated memory is initialized if the pointer has a
+// derived type, and is always initialized by PointerAllocateSource().
+// Performs all necessary coarray synchronization and validation actions.
+int RTNAME(PointerAllocate)(Descriptor &, bool hasStat = false,
+ const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+int RTNAME(PointerAllocateSource)(Descriptor &, const Descriptor &source,
+ bool hasStat = false, const Descriptor *errMsg = nullptr,
+ const char *sourceFile = nullptr, int sourceLine = 0);
+
+// Deallocates a data pointer, which must have been allocated by
+// PointerAllocate(), possibly copied with PointerAssociate().
+// Finalizes elements &/or components as needed. The pointer is left
+// in an initialized disassociated state suitable for reallocation
+// with the same bounds, cobounds, and length type parameters.
+int RTNAME(PointerDeallocate)(Descriptor &, bool hasStat = false,
+ const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+
+// Association inquiries for ASSOCIATED()
+
+// True when the pointer is not disassociated.
+bool RTNAME(PointerIsAssociated)(const Descriptor &);
+
+// True when the pointer is associated with a specific target.
+bool RTNAME(PointerIsAssociatedWith)(
+ const Descriptor &, const Descriptor &target);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_POINTER_H_
diff --git a/flang/test/Semantics/offsets01.f90 b/flang/test/Semantics/offsets01.f90
index 50974876e8d96..c3d66a5bc94ab 100644
--- a/flang/test/Semantics/offsets01.f90
+++ b/flang/test/Semantics/offsets01.f90
@@ -47,8 +47,8 @@ subroutine s5(n)
integer, len :: l2
real :: b(l1, l2)
end type
- type(t1(n)) :: x1 !CHECK: x1 size=48 offset=
- type(t2(n,n)) :: x2 !CHECK: x2 size=56 offset=
+ type(t1(n)) :: x1 !CHECK: x1 size=40 offset=
+ type(t2(n,n)) :: x2 !CHECK: x2 size=48 offset=
!CHECK: a size=48 offset=0:
!CHECK: b size=72 offset=0:
end
More information about the flang-commits
mailing list