//===-- 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(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(&x)}; const char *xDescLast{xDesc + x.SizeInBytes() - 1}; const char *yDesc{reinterpret_cast(&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()}; if (toIsDesc) { if (fromIsDesc) { auto *p{special.GetProc( bindings)}; p(to, from); } else { auto *p{special.GetProc(bindings)}; p(to, from.raw().base_addr); } } else { if (fromIsDesc) { auto *p{special.GetProc(bindings)}; p(to.raw().base_addr, from); } else { auto *p{special.GetProc(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 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.InlineElements()}; toElements-- > 0; to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { toElementDesc.set_base_addr(to.Element(toAt)); fromElementDesc.set_base_addr(from.Element(fromAt)); DoScalarDefinedAssignment(toElementDesc, fromElementDesc, derived, special); } } template 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(toAt)}; Fortran::runtime::memmove( p, from.Element>(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(); std::memcpy( reinterpret_cast(toDeallocate_), &to_, to_.SizeInBytes()); to_.set_base_addr(nullptr); if (toDerived_ && (flags_ & NeedFinalization)) { int status{workQueue.BeginFinalize(*toDeallocate_, *toDerived_)}; if (status == StatContinue) { // tempDescriptor_ state must outlive pending child ticket persist_ = true; } else if (status != StatOk) { 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(&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) { if (stat == StatContinue) { persist_ = true; } 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_.InlineElements()}; if (from_->rank() > 0) { std::size_t fromElements{from_->InlineElements()}; if (toElements != fromElements) { workQueue.terminator().Crash("Assign: mismatching element counts in " "array assignment (to %zd, from %zd)", toElements, fromElements); } } 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( to_, *from_, *toDerived_, flags_, memmoveFct_, toDeallocate_)}; status != StatOk && status != StatContinue) { return status; } } else { // elementwise if (int status{workQueue.BeginDerivedAssign( 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(to_, *from_, toAt, fromAt, toElements, toElementBytes, fromElementBytes); break; case CFI_type_char16_t: BlankPadCharacterAssignment(to_, *from_, toAt, fromAt, toElements, toElementBytes, fromElementBytes); break; case CFI_type_char32_t: BlankPadCharacterAssignment(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(toAt), from_->Element(fromAt), toElementBytes); } } } if (persist_) { // tempDescriptor_ must outlive pending child ticket(s) done_ = true; return StatContinue; } else { if (toDeallocate_) { toDeallocate_->Deallocate(); toDeallocate_ = nullptr; } return StatOk; } } template RT_API_ATTRS int DerivedAssignTicket::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(), this->from_->template OffsetElement(), this->instance_.InlineElements() * 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.InlineElements()}) { for (std::size_t k{0}; k < numProcPtrs; ++k) { const auto &procPtr{ *procPtrDesc.ZeroBasedIndexedElement(k)}; // Loop only over elements if (k > 0) { Elementwise::Reset(); } for (; !Elementwise::IsComplete(); Elementwise::Advance()) { memmoveFct_(this->instance_.template ElementComponent( this->subscripts_, procPtr.offset), this->from_->template ElementComponent( 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::Begin(WorkQueue &); template RT_API_ATTRS int DerivedAssignTicket::Begin(WorkQueue &); template RT_API_ATTRS int DerivedAssignTicket::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{ static_cast(this->component_->offset())}; char *to{this->instance_.template OffsetElement(offset)}; const char *from{ this->from_->template OffsetElement(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->SkipToNextComponent(); } else { memmoveFct_( this->instance_.template Element(this->subscripts_) + this->component_->offset(), this->from_->template Element(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{ static_cast(this->component_->offset())}; char *to{this->instance_.template OffsetElement(offset)}; const char *from{ this->from_->template OffsetElement(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->SkipToNextComponent(); } else { memmoveFct_(this->instance_.template Element(this->subscripts_) + this->component_->offset(), this->from_->template Element(this->fromSubscripts_) + this->component_->offset(), componentByteSize); this->Advance(); } } break; case typeInfo::Component::Genre::Allocatable: case typeInfo::Component::Genre::Automatic: { auto *toDesc{reinterpret_cast( this->instance_.template Element(this->subscripts_) + this->component_->offset())}; const auto *fromDesc{reinterpret_cast( this->from_->template Element(this->fromSubscripts_) + this->component_->offset())}; const auto *componentDerived{this->component_->derivedType()}; if (toDesc->IsAllocatable() && !fromDesc->IsAllocated()) { if (toDesc->IsAllocated()) { if (this->phase_ == 0) { if (componentDerived && !componentDerived->noDestructionNeeded()) { if (int status{workQueue.BeginDestroy( *toDesc, *componentDerived, /*finalize=*/false)}; status != StatOk) { this->phase_++; 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::Continue(WorkQueue &); template RT_API_ATTRS int DerivedAssignTicket::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.InlineElements()}; n-- > 0; alloc.IncrementSubscripts(allocAt)) { Descriptor allocElement{*Descriptor::Create(*allocDerived, reinterpret_cast(alloc.Element(allocAt)), 0)}; Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct); } } else { // intrinsic type for (std::size_t n{alloc.InlineElements()}; n-- > 0; alloc.IncrementSubscripts(allocAt)) { memmoveFct(alloc.Element(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