shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
llvm-project/flang-rt/lib/runtime/assign.cpp
Peter Klausler 2bf3ccabfa
[flang] Restructure runtime to avoid recursion (relanding) (#143993) 
Recursion, both direct and indirect, prevents accurate stack size
calculation at link time for GPU device code. Restructure these
recursive (often mutually so) routines in the Fortran runtime with new
implementations based on an iterative work queue with
suspendable/resumable work tickets: Assign, Initialize, initializeClone,
Finalize, and Destroy.

Default derived type I/O is also recursive, but already disabled. It can
be added to this new framework later if the overall approach succeeds.

Note that derived type FINAL subroutine calls, defined assignments, and
defined I/O procedures all perform callbacks into user code, which may
well reenter the runtime library. This kind of recursion is not handled
by this change, although it may be possible to do so in the future using
thread-local work queues.

(Relanding this patch after reverting initial attempt due to some test
failures that needed some time to analyze and fix.)

Fixes https://github.com/llvm/llvm-project/issues/142481.
2025-06-16 14:37:01 -07:00

829 lines
32 KiB
C++
Raw Blame History

//===-- lib/runtime/assign.cpp ----------------------------------*- 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
//
//===----------------------------------------------------------------------===//
#include "flang/Runtime/assign.h"
#include "flang-rt/runtime/assign-impl.h"
#include "flang-rt/runtime/derived.h"
#include "flang-rt/runtime/descriptor.h"
#include "flang-rt/runtime/stat.h"
#include "flang-rt/runtime/terminator.h"
#include "flang-rt/runtime/tools.h"
#include "flang-rt/runtime/type-info.h"
#include "flang-rt/runtime/work-queue.h"
namespace Fortran::runtime {
// Predicate: is the left-hand side of an assignment an allocated allocatable
// that must be deallocated?
static inline RT_API_ATTRS bool MustDeallocateLHS(
Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
// Top-level assignments to allocatable variables (*not* components)
// may first deallocate existing content if there's about to be a
// change in type or shape; see F'2018 10.2.1.3(3).
if (!(flags & MaybeReallocate)) {
return false;
}
if (!to.IsAllocatable() || !to.IsAllocated()) {
return false;
}
if (to.type() != from.type()) {
return true;
}
if (!(flags & ExplicitLengthCharacterLHS) && to.type().IsCharacter() &&
to.ElementBytes() != from.ElementBytes()) {
return true;
}
if (flags & PolymorphicLHS) {
DescriptorAddendum *toAddendum{to.Addendum()};
const typeInfo::DerivedType *toDerived{
toAddendum ? toAddendum->derivedType() : nullptr};
const DescriptorAddendum *fromAddendum{from.Addendum()};
const typeInfo::DerivedType *fromDerived{
fromAddendum ? fromAddendum->derivedType() : nullptr};
if (toDerived != fromDerived) {
return true;
}
if (fromDerived) {
// Distinct LEN parameters? Deallocate
std::size_t lenParms{fromDerived->LenParameters()};
for (std::size_t j{0}; j < lenParms; ++j) {
if (toAddendum->LenParameterValue(j) !=
fromAddendum->LenParameterValue(j)) {
return true;
}
}
}
}
if (from.rank() > 0) {
// Distinct shape? Deallocate
int rank{to.rank()};
for (int j{0}; j < rank; ++j) {
const auto &toDim{to.GetDimension(j)};
const auto &fromDim{from.GetDimension(j)};
if (toDim.Extent() != fromDim.Extent()) {
return true;
}
if ((flags & UpdateLHSBounds) &&
toDim.LowerBound() != fromDim.LowerBound()) {
return true;
}
}
}
// Not reallocating; may have to update bounds
if (flags & UpdateLHSBounds) {
int rank{to.rank()};
for (int j{0}; j < rank; ++j) {
to.GetDimension(j).SetLowerBound(from.GetDimension(j).LowerBound());
}
}
return false;
}
// Utility: allocate the allocatable left-hand side, either because it was
// originally deallocated or because it required reallocation
static RT_API_ATTRS int AllocateAssignmentLHS(
Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
to.raw().type = from.raw().type;
if (!(flags & ExplicitLengthCharacterLHS)) {
to.raw().elem_len = from.ElementBytes();
}
const typeInfo::DerivedType *derived{nullptr};
DescriptorAddendum *toAddendum{to.Addendum()};
if (const DescriptorAddendum * fromAddendum{from.Addendum()}) {
derived = fromAddendum->derivedType();
if (toAddendum) {
toAddendum->set_derivedType(derived);
std::size_t lenParms{derived ? derived->LenParameters() : 0};
for (std::size_t j{0}; j < lenParms; ++j) {
toAddendum->SetLenParameterValue(j, fromAddendum->LenParameterValue(j));
}
}
} else if (toAddendum) {
toAddendum->set_derivedType(nullptr);
}
// subtle: leave bounds in place when "from" is scalar (10.2.1.3(3))
int rank{from.rank()};
auto stride{static_cast<SubscriptValue>(to.ElementBytes())};
for (int j{0}; j < rank; ++j) {
auto &toDim{to.GetDimension(j)};
const auto &fromDim{from.GetDimension(j)};
toDim.SetBounds(fromDim.LowerBound(), fromDim.UpperBound());
toDim.SetByteStride(stride);
stride *= toDim.Extent();
}
return ReturnError(terminator, to.Allocate(kNoAsyncObject));
}
// least <= 0, most >= 0
static RT_API_ATTRS void MaximalByteOffsetRange(
const Descriptor &desc, std::int64_t &least, std::int64_t &most) {
least = most = 0;
if (desc.ElementBytes() == 0) {
return;
}
int n{desc.raw().rank};
for (int j{0}; j < n; ++j) {
const auto &dim{desc.GetDimension(j)};
auto extent{dim.Extent()};
if (extent > 0) {
auto sm{dim.ByteStride()};
if (sm < 0) {
least += (extent - 1) * sm;
} else {
most += (extent - 1) * sm;
}
}
}
most += desc.ElementBytes() - 1;
}
static inline RT_API_ATTRS bool RangesOverlap(const char *aStart,
const char *aEnd, const char *bStart, const char *bEnd) {
return aEnd >= bStart && bEnd >= aStart;
}
// Predicate: could the left-hand and right-hand sides of the assignment
// possibly overlap in memory? Note that the descriptors themeselves
// are included in the test.
static RT_API_ATTRS bool MayAlias(const Descriptor &x, const Descriptor &y) {
const char *xBase{x.OffsetElement()};
const char *yBase{y.OffsetElement()};
if (!xBase || !yBase) {
return false; // not both allocated
}
const char *xDesc{reinterpret_cast<const char *>(&x)};
const char *xDescLast{xDesc + x.SizeInBytes() - 1};
const char *yDesc{reinterpret_cast<const char *>(&y)};
const char *yDescLast{yDesc + y.SizeInBytes() - 1};
std::int64_t xLeast, xMost, yLeast, yMost;
MaximalByteOffsetRange(x, xLeast, xMost);
MaximalByteOffsetRange(y, yLeast, yMost);
if (RangesOverlap(xDesc, xDescLast, yBase + yLeast, yBase + yMost) ||
RangesOverlap(yDesc, yDescLast, xBase + xLeast, xBase + xMost)) {
// A descriptor overlaps with the storage described by the other;
// this can arise when an allocatable or pointer component is
// being assigned to/from.
return true;
}
if (!RangesOverlap(
xBase + xLeast, xBase + xMost, yBase + yLeast, yBase + yMost)) {
return false; // no storage overlap
}
// TODO: check dimensions: if any is independent, return false
return true;
}
static RT_API_ATTRS void DoScalarDefinedAssignment(const Descriptor &to,
const Descriptor &from, const typeInfo::DerivedType &derived,
const typeInfo::SpecialBinding &special) {
bool toIsDesc{special.IsArgDescriptor(0)};
bool fromIsDesc{special.IsArgDescriptor(1)};
const auto *bindings{
derived.binding().OffsetElement<const typeInfo::Binding>()};
if (toIsDesc) {
if (fromIsDesc) {
auto *p{special.GetProc<void (*)(const Descriptor &, const Descriptor &)>(
bindings)};
p(to, from);
} else {
auto *p{special.GetProc<void (*)(const Descriptor &, void *)>(bindings)};
p(to, from.raw().base_addr);
}
} else {
if (fromIsDesc) {
auto *p{special.GetProc<void (*)(void *, const Descriptor &)>(bindings)};
p(to.raw().base_addr, from);
} else {
auto *p{special.GetProc<void (*)(void *, void *)>(bindings)};
p(to.raw().base_addr, from.raw().base_addr);
}
}
}
static RT_API_ATTRS void DoElementalDefinedAssignment(const Descriptor &to,
const Descriptor &from, const typeInfo::DerivedType &derived,
const typeInfo::SpecialBinding &special) {
SubscriptValue toAt[maxRank], fromAt[maxRank];
to.GetLowerBounds(toAt);
from.GetLowerBounds(fromAt);
StaticDescriptor<maxRank, true, 8 /*?*/> statDesc[2];
Descriptor &toElementDesc{statDesc[0].descriptor()};
Descriptor &fromElementDesc{statDesc[1].descriptor()};
toElementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer);
fromElementDesc.Establish(
derived, nullptr, 0, nullptr, CFI_attribute_pointer);
for (std::size_t toElements{to.Elements()}; toElements-- > 0;
to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
toElementDesc.set_base_addr(to.Element<char>(toAt));
fromElementDesc.set_base_addr(from.Element<char>(fromAt));
DoScalarDefinedAssignment(toElementDesc, fromElementDesc, derived, special);
}
}
template <typename CHAR>
static RT_API_ATTRS void BlankPadCharacterAssignment(Descriptor &to,
const Descriptor &from, SubscriptValue toAt[], SubscriptValue fromAt[],
std::size_t elements, std::size_t toElementBytes,
std::size_t fromElementBytes) {
std::size_t padding{(toElementBytes - fromElementBytes) / sizeof(CHAR)};
std::size_t copiedCharacters{fromElementBytes / sizeof(CHAR)};
for (; elements-- > 0;
to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
CHAR *p{to.Element<CHAR>(toAt)};
Fortran::runtime::memmove(
p, from.Element<std::add_const_t<CHAR>>(fromAt), fromElementBytes);
p += copiedCharacters;
for (auto n{padding}; n-- > 0;) {
*p++ = CHAR{' '};
}
}
}
RT_OFFLOAD_API_GROUP_BEGIN
// Common implementation of assignments, both intrinsic assignments and
// those cases of polymorphic user-defined ASSIGNMENT(=) TBPs that could not
// be resolved in semantics. Most assignment statements do not need any
// of the capabilities of this function -- but when the LHS is allocatable,
// the type might have a user-defined ASSIGNMENT(=), or the type might be
// finalizable, this function should be used.
// When "to" is not a whole allocatable, "from" is an array, and defined
// assignments are not used, "to" and "from" only need to have the same number
// of elements, but their shape need not to conform (the assignment is done in
// element sequence order). This facilitates some internal usages, like when
// dealing with array constructors.
RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from,
Terminator &terminator, int flags, MemmoveFct memmoveFct) {
WorkQueue workQueue{terminator};
if (workQueue.BeginAssign(to, from, flags, memmoveFct, nullptr) ==
StatContinue) {
workQueue.Run();
}
}
RT_API_ATTRS int AssignTicket::Begin(WorkQueue &workQueue) {
bool mustDeallocateLHS{(flags_ & DeallocateLHS) ||
MustDeallocateLHS(to_, *from_, workQueue.terminator(), flags_)};
DescriptorAddendum *toAddendum{to_.Addendum()};
toDerived_ = toAddendum ? toAddendum->derivedType() : nullptr;
if (toDerived_ && (flags_ & NeedFinalization) &&
toDerived_->noFinalizationNeeded()) {
flags_ &= ~NeedFinalization;
}
if (MayAlias(to_, *from_)) {
if (mustDeallocateLHS) {
// Convert the LHS into a temporary, then make it look deallocated.
toDeallocate_ = &tempDescriptor_.descriptor();
persist_ = true; // tempDescriptor_ state must outlive child tickets
std::memcpy(
reinterpret_cast<void *>(toDeallocate_), &to_, to_.SizeInBytes());
to_.set_base_addr(nullptr);
if (toDerived_ && (flags_ & NeedFinalization)) {
if (int status{workQueue.BeginFinalize(*toDeallocate_, *toDerived_)};
status != StatOk && status != StatContinue) {
return status;
}
flags_ &= ~NeedFinalization;
}
} else if (!IsSimpleMemmove()) {
// Handle LHS/RHS aliasing by copying RHS into a temp, then
// recursively assigning from that temp.
auto descBytes{from_->SizeInBytes()};
Descriptor &newFrom{tempDescriptor_.descriptor()};
persist_ = true; // tempDescriptor_ state must outlive child tickets
std::memcpy(reinterpret_cast<void *>(&newFrom), from_, descBytes);
// Pretend the temporary descriptor is for an ALLOCATABLE
// entity, otherwise, the Deallocate() below will not
// free the descriptor memory.
newFrom.raw().attribute = CFI_attribute_allocatable;
if (int stat{ReturnError(
workQueue.terminator(), newFrom.Allocate(kNoAsyncObject))};
stat != StatOk) {
return stat;
}
if (HasDynamicComponent(*from_)) {
// If 'from' has allocatable/automatic component, we cannot
// just make a shallow copy of the descriptor member.
// This will still leave data overlap in 'to' and 'newFrom'.
// For example:
// type t
// character, allocatable :: c(:)
// end type t
// type(t) :: x(3)
// x(2:3) = x(1:2)
// We have to make a deep copy into 'newFrom' in this case.
if (const DescriptorAddendum *addendum{newFrom.Addendum()}) {
if (const auto *derived{addendum->derivedType()}) {
if (!derived->noInitializationNeeded()) {
if (int status{workQueue.BeginInitialize(newFrom, *derived)};
status != StatOk && status != StatContinue) {
return status;
}
}
}
}
static constexpr int nestedFlags{MaybeReallocate | PolymorphicLHS};
if (int status{workQueue.BeginAssign(
newFrom, *from_, nestedFlags, memmoveFct_, nullptr)};
status != StatOk && status != StatContinue) {
return status;
}
} else {
ShallowCopy(newFrom, *from_, true, from_->IsContiguous());
}
from_ = &newFrom; // this is why from_ has to be a pointer
flags_ &= NeedFinalization | ComponentCanBeDefinedAssignment |
ExplicitLengthCharacterLHS | CanBeDefinedAssignment;
toDeallocate_ = &newFrom;
}
}
if (to_.IsAllocatable()) {
if (mustDeallocateLHS) {
if (!toDeallocate_ && to_.IsAllocated()) {
toDeallocate_ = &to_;
}
} else if (to_.rank() != from_->rank() && !to_.IsAllocated()) {
workQueue.terminator().Crash("Assign: mismatched ranks (%d != %d) in "
"assignment to unallocated allocatable",
to_.rank(), from_->rank());
}
} else if (!to_.IsAllocated()) {
workQueue.terminator().Crash(
"Assign: left-hand side variable is neither allocated nor allocatable");
}
if (toDerived_ && to_.IsAllocated()) {
// Schedule finalization or destruction of the LHS.
if (flags_ & NeedFinalization) {
if (int status{workQueue.BeginFinalize(to_, *toDerived_)};
status != StatOk && status != StatContinue) {
return status;
}
} else if (!toDerived_->noDestructionNeeded()) {
if (int status{
workQueue.BeginDestroy(to_, *toDerived_, /*finalize=*/false)};
status != StatOk && status != StatContinue) {
return status;
}
}
}
return StatContinue;
}
RT_API_ATTRS int AssignTicket::Continue(WorkQueue &workQueue) {
if (done_) {
// All child tickets are complete; can release this ticket's state.
if (toDeallocate_) {
toDeallocate_->Deallocate();
}
return StatOk;
}
// All necessary finalization or destruction that was initiated by Begin()
// has been completed. Deallocation may be pending, and if it's for the LHS,
// do it now so that the LHS gets reallocated.
if (toDeallocate_ == &to_) {
toDeallocate_ = nullptr;
to_.Deallocate();
}
// Allocate the LHS if needed
if (!to_.IsAllocated()) {
if (int stat{
AllocateAssignmentLHS(to_, *from_, workQueue.terminator(), flags_)};
stat != StatOk) {
return stat;
}
const auto *addendum{to_.Addendum()};
toDerived_ = addendum ? addendum->derivedType() : nullptr;
if (toDerived_) {
if (!toDerived_->noInitializationNeeded()) {
if (int status{workQueue.BeginInitialize(to_, *toDerived_)};
status != StatOk) {
return status;
}
}
}
}
// Check for a user-defined assignment type-bound procedure;
// see 10.2.1.4-5.
// Note that the aliasing and LHS (re)allocation handling above
// needs to run even with CanBeDefinedAssignment flag, since
// Assign() can be invoked recursively for component-wise assignments.
// The declared type (if known) must be used for generic resolution
// of ASSIGNMENT(=) to a binding, but that binding can be overridden.
if (declaredType_ && (flags_ & CanBeDefinedAssignment)) {
if (to_.rank() == 0) {
if (const auto *special{declaredType_->FindSpecialBinding(
typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
DoScalarDefinedAssignment(to_, *from_, *toDerived_, *special);
done_ = true;
return StatContinue;
}
}
if (const auto *special{declaredType_->FindSpecialBinding(
typeInfo::SpecialBinding::Which::ElementalAssignment)}) {
DoElementalDefinedAssignment(to_, *from_, *toDerived_, *special);
done_ = true;
return StatContinue;
}
}
// Intrinsic assignment
std::size_t toElements{to_.Elements()};
if (from_->rank() > 0 && toElements != from_->Elements()) {
workQueue.terminator().Crash("Assign: mismatching element counts in array "
"assignment (to %zd, from %zd)",
toElements, from_->Elements());
}
if (to_.type() != from_->type()) {
workQueue.terminator().Crash(
"Assign: mismatching types (to code %d != from code %d)",
to_.type().raw(), from_->type().raw());
}
std::size_t toElementBytes{to_.ElementBytes()};
std::size_t fromElementBytes{from_->ElementBytes()};
if (toElementBytes > fromElementBytes && !to_.type().IsCharacter()) {
workQueue.terminator().Crash("Assign: mismatching non-character element "
"sizes (to %zd bytes != from %zd bytes)",
toElementBytes, fromElementBytes);
}
if (toDerived_) {
if (toDerived_->noDefinedAssignment()) { // componentwise
if (int status{workQueue.BeginDerivedAssign<true>(
to_, *from_, *toDerived_, flags_, memmoveFct_, toDeallocate_)};
status != StatOk && status != StatContinue) {
return status;
}
} else { // elementwise
if (int status{workQueue.BeginDerivedAssign<false>(
to_, *from_, *toDerived_, flags_, memmoveFct_, toDeallocate_)};
status != StatOk && status != StatContinue) {
return status;
}
}
toDeallocate_ = nullptr;
} else if (IsSimpleMemmove()) {
memmoveFct_(to_.raw().base_addr, from_->raw().base_addr,
toElements * toElementBytes);
} else {
// Scalar expansion of the RHS is implied by using the same empty
// subscript values on each (seemingly) elemental reference into
// "from".
SubscriptValue toAt[maxRank];
to_.GetLowerBounds(toAt);
SubscriptValue fromAt[maxRank];
from_->GetLowerBounds(fromAt);
if (toElementBytes > fromElementBytes) { // blank padding
switch (to_.type().raw()) {
case CFI_type_signed_char:
case CFI_type_char:
BlankPadCharacterAssignment<char>(to_, *from_, toAt, fromAt, toElements,
toElementBytes, fromElementBytes);
break;
case CFI_type_char16_t:
BlankPadCharacterAssignment<char16_t>(to_, *from_, toAt, fromAt,
toElements, toElementBytes, fromElementBytes);
break;
case CFI_type_char32_t:
BlankPadCharacterAssignment<char32_t>(to_, *from_, toAt, fromAt,
toElements, toElementBytes, fromElementBytes);
break;
default:
workQueue.terminator().Crash(
"unexpected type code %d in blank padded Assign()",
to_.type().raw());
}
} else { // elemental copies, possibly with character truncation
for (std::size_t n{toElements}; n-- > 0;
to_.IncrementSubscripts(toAt), from_->IncrementSubscripts(fromAt)) {
memmoveFct_(to_.Element<char>(toAt), from_->Element<const char>(fromAt),
toElementBytes);
}
}
}
if (persist_) {
done_ = true;
return StatContinue;
} else {
if (toDeallocate_) {
toDeallocate_->Deallocate();
toDeallocate_ = nullptr;
}
return StatOk;
}
}
template <bool IS_COMPONENTWISE>
RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Begin(
WorkQueue &workQueue) {
if (toIsContiguous_ && fromIsContiguous_ &&
this->derived_.noDestructionNeeded() &&
this->derived_.noDefinedAssignment() &&
this->instance_.rank() == this->from_->rank()) {
if (std::size_t elementBytes{this->instance_.ElementBytes()};
elementBytes == this->from_->ElementBytes()) {
// Fastest path. Both LHS and RHS are contiguous, RHS is not a scalar
// to be expanded, the types have the same size, and there are no
// allocatable components or defined ASSIGNMENT(=) at any level.
memmoveFct_(this->instance_.template OffsetElement<char>(),
this->from_->template OffsetElement<const char *>(),
this->instance_.Elements() * elementBytes);
return StatOk;
}
}
// Use PolymorphicLHS for components so that the right things happen
// when the components are polymorphic; when they're not, they're both
// not, and their declared types will match.
int nestedFlags{MaybeReallocate | PolymorphicLHS};
if (flags_ & ComponentCanBeDefinedAssignment) {
nestedFlags |= CanBeDefinedAssignment | ComponentCanBeDefinedAssignment;
}
flags_ = nestedFlags;
// Copy procedure pointer components
const Descriptor &procPtrDesc{this->derived_.procPtr()};
bool noDataComponents{this->IsComplete()};
if (std::size_t numProcPtrs{procPtrDesc.Elements()}) {
for (std::size_t k{0}; k < numProcPtrs; ++k) {
const auto &procPtr{
*procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
// Loop only over elements
if (k > 0) {
Elementwise::Reset();
}
for (; !Elementwise::IsComplete(); Elementwise::Advance()) {
memmoveFct_(this->instance_.template ElementComponent<char>(
this->subscripts_, procPtr.offset),
this->from_->template ElementComponent<const char>(
this->fromSubscripts_, procPtr.offset),
sizeof(typeInfo::ProcedurePointer));
}
}
if (noDataComponents) {
return StatOk;
}
Elementwise::Reset();
}
if (noDataComponents) {
return StatOk;
}
return StatContinue;
}
template RT_API_ATTRS int DerivedAssignTicket<false>::Begin(WorkQueue &);
template RT_API_ATTRS int DerivedAssignTicket<true>::Begin(WorkQueue &);
template <bool IS_COMPONENTWISE>
RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
WorkQueue &workQueue) {
while (!this->IsComplete()) {
// Copy the data components (incl. the parent) first.
switch (this->component_->genre()) {
case typeInfo::Component::Genre::Data:
if (this->component_->category() == TypeCategory::Derived) {
Descriptor &toCompDesc{this->componentDescriptor_.descriptor()};
Descriptor &fromCompDesc{this->fromComponentDescriptor_.descriptor()};
this->component_->CreatePointerDescriptor(toCompDesc, this->instance_,
workQueue.terminator(), this->subscripts_);
this->component_->CreatePointerDescriptor(fromCompDesc, *this->from_,
workQueue.terminator(), this->fromSubscripts_);
const auto *componentDerived{this->component_->derivedType()};
this->Advance();
if (int status{workQueue.BeginAssign(toCompDesc, fromCompDesc, flags_,
memmoveFct_, componentDerived)};
status != StatOk) {
return status;
}
} else { // Component has intrinsic type; simply copy raw bytes
std::size_t componentByteSize{
this->component_->SizeInBytes(this->instance_)};
if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) {
std::size_t offset{this->component_->offset()};
char *to{this->instance_.template OffsetElement<char>(offset)};
const char *from{
this->from_->template OffsetElement<const char>(offset)};
std::size_t toElementStride{this->instance_.ElementBytes()};
std::size_t fromElementStride{
this->from_->rank() == 0 ? 0 : this->from_->ElementBytes()};
if (toElementStride == fromElementStride &&
toElementStride == componentByteSize) {
memmoveFct_(to, from, this->elements_ * componentByteSize);
} else {
for (std::size_t n{this->elements_}; n--;
to += toElementStride, from += fromElementStride) {
memmoveFct_(to, from, componentByteSize);
}
}
this->Componentwise::Advance();
} else {
memmoveFct_(
this->instance_.template Element<char>(this->subscripts_) +
this->component_->offset(),
this->from_->template Element<const char>(this->fromSubscripts_) +
this->component_->offset(),
componentByteSize);
this->Advance();
}
}
break;
case typeInfo::Component::Genre::Pointer: {
std::size_t componentByteSize{
this->component_->SizeInBytes(this->instance_)};
if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) {
std::size_t offset{this->component_->offset()};
char *to{this->instance_.template OffsetElement<char>(offset)};
const char *from{
this->from_->template OffsetElement<const char>(offset)};
std::size_t toElementStride{this->instance_.ElementBytes()};
std::size_t fromElementStride{
this->from_->rank() == 0 ? 0 : this->from_->ElementBytes()};
if (toElementStride == fromElementStride &&
toElementStride == componentByteSize) {
memmoveFct_(to, from, this->elements_ * componentByteSize);
} else {
for (std::size_t n{this->elements_}; n--;
to += toElementStride, from += fromElementStride) {
memmoveFct_(to, from, componentByteSize);
}
}
this->Componentwise::Advance();
} else {
memmoveFct_(this->instance_.template Element<char>(this->subscripts_) +
this->component_->offset(),
this->from_->template Element<const char>(this->fromSubscripts_) +
this->component_->offset(),
componentByteSize);
this->Advance();
}
} break;
case typeInfo::Component::Genre::Allocatable:
case typeInfo::Component::Genre::Automatic: {
auto *toDesc{reinterpret_cast<Descriptor *>(
this->instance_.template Element<char>(this->subscripts_) +
this->component_->offset())};
const auto *fromDesc{reinterpret_cast<const Descriptor *>(
this->from_->template Element<char>(this->fromSubscripts_) +
this->component_->offset())};
const auto *componentDerived{this->component_->derivedType()};
if (toDesc->IsAllocatable() && !fromDesc->IsAllocated()) {
if (toDesc->IsAllocated()) {
if (this->phase_ == 0) {
this->phase_++;
if (componentDerived && !componentDerived->noDestructionNeeded()) {
if (int status{workQueue.BeginDestroy(
*toDesc, *componentDerived, /*finalize=*/false)};
status != StatOk) {
return status;
}
}
}
toDesc->Deallocate();
}
this->Advance();
} else {
// Allocatable components of the LHS are unconditionally
// deallocated before assignment (F'2018 10.2.1.3(13)(1)),
// unlike a "top-level" assignment to a variable, where
// deallocation is optional.
int nestedFlags{flags_};
if (!componentDerived ||
(componentDerived->noFinalizationNeeded() &&
componentDerived->noInitializationNeeded() &&
componentDerived->noDestructionNeeded())) {
// The actual deallocation might be avoidable when the existing
// location can be reoccupied.
nestedFlags |= MaybeReallocate | UpdateLHSBounds;
} else {
// Force LHS deallocation with DeallocateLHS flag.
nestedFlags |= DeallocateLHS;
}
this->Advance();
if (int status{workQueue.BeginAssign(*toDesc, *fromDesc, nestedFlags,
memmoveFct_, componentDerived)};
status != StatOk) {
return status;
}
}
} break;
}
}
if (deallocateAfter_) {
deallocateAfter_->Deallocate();
}
return StatOk;
}
template RT_API_ATTRS int DerivedAssignTicket<false>::Continue(WorkQueue &);
template RT_API_ATTRS int DerivedAssignTicket<true>::Continue(WorkQueue &);
RT_API_ATTRS void DoFromSourceAssign(Descriptor &alloc,
const Descriptor &source, Terminator &terminator, MemmoveFct memmoveFct) {
if (alloc.rank() > 0 && source.rank() == 0) {
// The value of each element of allocate object becomes the value of source.
DescriptorAddendum *allocAddendum{alloc.Addendum()};
const typeInfo::DerivedType *allocDerived{
allocAddendum ? allocAddendum->derivedType() : nullptr};
SubscriptValue allocAt[maxRank];
alloc.GetLowerBounds(allocAt);
if (allocDerived) {
for (std::size_t n{alloc.Elements()}; n-- > 0;
alloc.IncrementSubscripts(allocAt)) {
Descriptor allocElement{*Descriptor::Create(*allocDerived,
reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0)};
Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct);
}
} else { // intrinsic type
for (std::size_t n{alloc.Elements()}; n-- > 0;
alloc.IncrementSubscripts(allocAt)) {
memmoveFct(alloc.Element<char>(allocAt), source.raw().base_addr,
alloc.ElementBytes());
}
}
} else {
Assign(alloc, source, terminator, NoAssignFlags, memmoveFct);
}
}
RT_OFFLOAD_API_GROUP_END
extern "C" {
RT_EXT_API_GROUP_BEGIN
void RTDEF(Assign)(Descriptor &to, const Descriptor &from,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
// All top-level defined assignments can be recognized in semantics and
// will have been already been converted to calls, so don't check for
// defined assignment apart from components.
Assign(to, from, terminator,
MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment);
}
void RTDEF(AssignTemporary)(Descriptor &to, const Descriptor &from,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
// Initialize the "to" if it is of derived type that needs initialization.
if (const DescriptorAddendum * addendum{to.Addendum()}) {
if (const auto *derived{addendum->derivedType()}) {
// Do not invoke the initialization, if the descriptor is unallocated.
// AssignTemporary() is used for component-by-component assignments,
// for example, for structure constructors. This means that the LHS
// may be an allocatable component with unallocated status.
// The initialization will just fail in this case. By skipping
// the initialization we let Assign() automatically allocate
// and initialize the component according to the RHS.
// So we only need to initialize the LHS here if it is allocated.
// Note that initializing already initialized entity has no visible
// effect, though, it is assumed that the compiler does not initialize
// the temporary and leaves the initialization to this runtime code.
if (!derived->noInitializationNeeded() && to.IsAllocated()) {
if (ReturnError(terminator, Initialize(to, *derived, terminator)) !=
StatOk) {
return;
}
}
}
}
Assign(to, from, terminator, MaybeReallocate | PolymorphicLHS);
}
void RTDEF(CopyInAssign)(Descriptor &temp, const Descriptor &var,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
temp = var;
temp.set_base_addr(nullptr);
temp.raw().attribute = CFI_attribute_allocatable;
temp.Allocate(kNoAsyncObject);
ShallowCopy(temp, var);
}
void RTDEF(CopyOutAssign)(
Descriptor *var, Descriptor &temp, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
// Copyout from the temporary must not cause any finalizations
// for LHS. The variable must be properly initialized already.
if (var) {
ShallowCopy(*var, temp);
}
temp.Deallocate();
}
void RTDEF(AssignExplicitLengthCharacter)(Descriptor &to,
const Descriptor &from, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Assign(to, from, terminator,
MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment |
ExplicitLengthCharacterLHS);
}
void RTDEF(AssignPolymorphic)(Descriptor &to, const Descriptor &from,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Assign(to, from, terminator,
MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment |
PolymorphicLHS);
}
RT_EXT_API_GROUP_END
} // extern "C"
} // namespace Fortran::runtime
Reference in New Issue View Git Blame Copy Permalink