diff --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h --- a/flang/include/flang/Runtime/assign.h +++ b/flang/include/flang/Runtime/assign.h @@ -17,8 +17,8 @@ // must arrive here. // // Non-type-bound generic INTERFACE ASSIGNMENT(=) is resolved in semantics and -// need not be handled here in the runtime; ditto for type conversions on -// intrinsic assignments. +// need not be handled here in the runtime apart from derived type components; +// ditto for type conversions on intrinsic assignments. #ifndef FORTRAN_RUNTIME_ASSIGN_H_ #define FORTRAN_RUNTIME_ASSIGN_H_ @@ -32,6 +32,10 @@ // API for lowering assignment void RTNAME(Assign)(Descriptor &to, const Descriptor &from, const char *sourceFile = nullptr, int sourceLine = 0); +// This variant has no finalization, defined assignment, or allocatable +// reallocation. +void RTNAME(AssignTemporary)(Descriptor &to, const Descriptor &from, + const char *sourceFile = nullptr, int sourceLine = 0); } // extern "C" } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_ASSIGN_H_ diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp --- a/flang/runtime/allocatable.cpp +++ b/flang/runtime/allocatable.cpp @@ -7,7 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Runtime/allocatable.h" -#include "assign.h" +#include "assign-impl.h" #include "derived.h" #include "stat.h" #include "terminator.h" diff --git a/flang/runtime/assign.h b/flang/runtime/assign-impl.h rename from flang/runtime/assign.h rename to flang/runtime/assign-impl.h --- a/flang/runtime/assign.h +++ b/flang/runtime/assign-impl.h @@ -1,4 +1,4 @@ -//===-- runtime/assign.h-----------------------------------------*- C++ -*-===// +//===-- runtime/assign-impl.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. @@ -6,8 +6,8 @@ // //===----------------------------------------------------------------------===// -#ifndef FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_ -#define FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_ +#ifndef FORTRAN_RUNTIME_ASSIGN_IMPL_H_ +#define FORTRAN_RUNTIME_ASSIGN_IMPL_H_ namespace Fortran::runtime { class Descriptor; @@ -20,4 +20,4 @@ void DoFromSourceAssign(Descriptor &, const Descriptor &, Terminator &); } // namespace Fortran::runtime -#endif // FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_ +#endif // FORTRAN_RUNTIME_ASSIGN_IMPL_H_ diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp --- a/flang/runtime/assign.cpp +++ b/flang/runtime/assign.cpp @@ -7,7 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Runtime/assign.h" -#include "assign.h" +#include "assign-impl.h" #include "derived.h" #include "stat.h" #include "terminator.h" @@ -16,6 +16,140 @@ namespace Fortran::runtime { +// Predicate: is the left-hand side of an assignment an allocated allocatable +// that must be deallocated? +static inline bool MustDeallocateLHS( + Descriptor &to, const Descriptor &from, Terminator &terminator) { + // 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 (!to.IsAllocatable() || !to.IsAllocated()) { + return false; + } + if (to.type() != from.type()) { + return true; + } + 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 (toAddendum) { + // Distinct LEN parameters? Deallocate + std::size_t lenParms{fromDerived ? fromDerived->LenParameters() : 0}; + 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) { + if (to.GetDimension(j).Extent() != from.GetDimension(j).Extent()) { + return true; + } + } + } + return false; +} + +// Utility: allocate the allocatable left-hand side, either because it was +// originally deallocated or because it required reallocation +static int AllocateAssignmentLHS( + Descriptor &to, const Descriptor &from, Terminator &terminator) { + to.raw().type = from.raw().type; + to.raw().elem_len = from.ElementBytes(); + const typeInfo::DerivedType *derived{nullptr}; + if (const DescriptorAddendum * fromAddendum{from.Addendum()}) { + derived = fromAddendum->derivedType(); + if (DescriptorAddendum * toAddendum{to.Addendum()}) { + 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)); + } + } + } + // 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(); + } + int result{ReturnError(terminator, to.Allocate())}; + if (result == StatOk && derived && !derived->noInitializationNeeded()) { + result = ReturnError(terminator, Initialize(to, *derived, terminator)); + } + return result; +} + +// least <= 0, most >= 0 +static 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 * sm; + } else { + most += extent * sm; + } + } + } + most += desc.ElementBytes() - 1; +} + +static inline 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 bool MayAlias(const Descriptor &x, const Descriptor &y) { + const char *xDesc{reinterpret_cast(&x)}; + const char *xDescLast{xDesc + x.SizeInBytes()}; + const char *yDesc{reinterpret_cast(&x)}; + const char *yDescLast{yDesc + y.SizeInBytes()}; + std::int64_t xLeast, xMost, yLeast, yMost; + MaximalByteOffsetRange(x, xLeast, xMost); + MaximalByteOffsetRange(y, yLeast, yMost); + const char *xBase{x.OffsetElement()}; + const char *yBase{y.OffsetElement()}; + 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 void DoScalarDefinedAssignment(const Descriptor &to, const Descriptor &from, const typeInfo::SpecialBinding &special) { bool toIsDesc{special.IsArgDescriptor(0)}; @@ -41,8 +175,10 @@ } static void DoElementalDefinedAssignment(const Descriptor &to, - const Descriptor &from, const typeInfo::SpecialBinding &special, - std::size_t toElements, SubscriptValue toAt[], SubscriptValue fromAt[]) { + const Descriptor &from, 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()}; @@ -52,66 +188,92 @@ fromElementDesc = from; fromElementDesc.raw().attribute = CFI_attribute_pointer; fromElementDesc.raw().rank = 0; - for (std::size_t j{0}; j < toElements; - ++j, to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { + for (std::size_t toElements{to.Elements()}; 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, special); } } -// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or -// type-bound (only!) defined assignment (10.2.1.4), as appropriate. Performs -// finalization, scalar expansion, & allocatable (re)allocation as needed. -// Does not perform intrinsic assignment implicit type conversion. Both -// descriptors must be initialized. Recurses as needed to handle components. -// Do not perform allocatable reallocation if \p skipRealloc is true, which is -// used for allocate statement with source specifier. +// 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. static void Assign(Descriptor &to, const Descriptor &from, - Terminator &terminator, bool skipRealloc = false, - bool skipFinalization = false) { + Terminator &terminator, bool maybeReallocate, bool needFinalization, + bool canBeDefinedAssignment, bool componentCanBeDefinedAssignment) { + bool mustDeallocateLHS{ + maybeReallocate && MustDeallocateLHS(to, from, terminator)}; 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}; - bool wasJustAllocated{false}; - if (to.IsAllocatable()) { - std::size_t lenParms{fromDerived ? fromDerived->LenParameters() : 0}; - if (to.IsAllocated() && !skipRealloc) { - // 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). - bool deallocate{false}; - if (to.type() != from.type()) { - deallocate = true; - } else if (toDerived != fromDerived) { - deallocate = true; - } else { - if (toAddendum) { - // Distinct LEN parameters? Deallocate - for (std::size_t j{0}; j < lenParms; ++j) { - if (toAddendum->LenParameterValue(j) != - fromAddendum->LenParameterValue(j)) { - deallocate = true; - break; - } - } - } - if (from.rank() > 0) { - // Distinct shape? Deallocate - int rank{to.rank()}; - for (int j{0}; j < rank; ++j) { - if (to.GetDimension(j).Extent() != from.GetDimension(j).Extent()) { - deallocate = true; - break; - } + if (canBeDefinedAssignment && toDerived) { + needFinalization &= !toDerived->noFinalizationNeeded(); + // Check for a user-defined assignment type-bound procedure; + // see 10.2.1.4-5. A user-defined assignment TBP defines all of + // the semantics, including allocatable (re)allocation and any + // finalization. + if (to.rank() == 0) { + if (const auto *special{toDerived->FindSpecialBinding( + typeInfo::SpecialBinding::Which::ScalarAssignment)}) { + return DoScalarDefinedAssignment(to, from, *special); + } + } + if (const auto *special{toDerived->FindSpecialBinding( + typeInfo::SpecialBinding::Which::ElementalAssignment)}) { + return DoElementalDefinedAssignment(to, from, *special); + } + } + bool isSimpleMemmove{!toDerived && to.rank() == from.rank() && + to.IsContiguous() && from.IsContiguous()}; + StaticDescriptor deferredDeallocStatDesc; + Descriptor *deferDeallocation{nullptr}; + if (MayAlias(to, from)) { + if (mustDeallocateLHS) { + deferDeallocation = &deferredDeallocStatDesc.descriptor(); + std::memcpy(deferDeallocation, &to, to.SizeInBytes()); + to.set_base_addr(nullptr); + } else if (!isSimpleMemmove) { + // Handle LHS/RHS aliasing by copying RHS into a temp, then + // recursively assigning from that temp. + auto descBytes{from.SizeInBytes()}; + StaticDescriptor staticDesc; + Descriptor &newFrom{staticDesc.descriptor()}; + std::memcpy(&newFrom, &from, descBytes); + auto stat{ReturnError(terminator, newFrom.Allocate())}; + if (stat == StatOk) { + char *toAt{newFrom.OffsetElement()}; + std::size_t fromElements{from.Elements()}; + std::size_t elementBytes{from.ElementBytes()}; + if (from.IsContiguous()) { + std::memcpy(toAt, from.OffsetElement(), fromElements * elementBytes); + } else { + SubscriptValue fromAt[maxRank]; + for (from.GetLowerBounds(fromAt); fromElements-- > 0; + toAt += elementBytes, from.IncrementSubscripts(fromAt)) { + std::memcpy(toAt, from.Element(fromAt), elementBytes); } } + Assign(to, newFrom, terminator, /*maybeReallocate=*/false, + needFinalization, false, componentCanBeDefinedAssignment); + newFrom.Deallocate(); } - if (deallocate) { - to.Destroy(true /*finalize*/); + return; + } + } + if (to.IsAllocatable()) { + if (mustDeallocateLHS) { + if (deferDeallocation) { + if (needFinalization && toDerived) { + Finalize(to, *toDerived); + needFinalization = false; + } + } else { + to.Destroy(/*finalize=*/needFinalization); + needFinalization = false; } } else if (to.rank() != from.rank()) { terminator.Crash("Assign: mismatched ranks (%d != %d) in assignment to " @@ -119,31 +281,10 @@ to.rank(), from.rank()); } if (!to.IsAllocated()) { - to.raw().type = from.raw().type; - to.raw().elem_len = from.ElementBytes(); - if (toAddendum) { - toDerived = fromDerived; - toAddendum->set_derivedType(toDerived); - for (std::size_t j{0}; j < lenParms; ++j) { - toAddendum->SetLenParameterValue( - j, fromAddendum->LenParameterValue(j)); - } - } - // 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(); + if (AllocateAssignmentLHS(to, from, terminator) != StatOk) { + return; } - ReturnError(terminator, to.Allocate()); - if (fromDerived && !fromDerived->noInitializationNeeded()) { - ReturnError(terminator, Initialize(to, *toDerived, terminator)); - } - wasJustAllocated = true; + needFinalization = false; } } SubscriptValue toAt[maxRank]; @@ -169,24 +310,11 @@ "Assign: mismatching element sizes (to %zd bytes != from %zd bytes)", elementBytes, from.ElementBytes()); } - if (toDerived) { // Derived type assignment - // Check for defined assignment type-bound procedures (10.2.1.4-5) - if (to.rank() == 0) { - if (const auto *special{toDerived->FindSpecialBinding( - typeInfo::SpecialBinding::Which::ScalarAssignment)}) { - return DoScalarDefinedAssignment(to, from, *special); - } - } - if (const auto *special{toDerived->FindSpecialBinding( - typeInfo::SpecialBinding::Which::ElementalAssignment)}) { - return DoElementalDefinedAssignment( - to, from, *special, toElements, toAt, fromAt); - } + if (toDerived) { // Derived type intrinsic assignment, which is componentwise and elementwise // for all components, including parent components (10.2.1.2-3). // The target is first finalized if still necessary (7.5.6.3(1)) - if (!wasJustAllocated && !toDerived->noFinalizationNeeded() && - !skipFinalization) { + if (needFinalization) { Finalize(to, *toDerived); } // Copy the data components (incl. the parent) first. @@ -207,8 +335,10 @@ comp.CreatePointerDescriptor(toCompDesc, to, terminator, toAt); comp.CreatePointerDescriptor( fromCompDesc, from, terminator, fromAt); - Assign(toCompDesc, fromCompDesc, terminator, /*skipRealloc=*/false, - /*skipFinalization=*/true); + Assign(toCompDesc, fromCompDesc, terminator, + /*maybeReallocate=*/true, + /*needFinalization=*/false, componentCanBeDefinedAssignment, + componentCanBeDefinedAssignment); } } else { // Component has intrinsic type; simply copy raw bytes std::size_t componentByteSize{comp.SizeInBytes(to)}; @@ -253,7 +383,9 @@ continue; // F'2018 10.2.1.3(13)(2) } } - Assign(*toDesc, *fromDesc, terminator, /*skipRealloc=*/false); + Assign(*toDesc, *fromDesc, terminator, /*maybeReallocate=*/true, + /*needFinalization=*/false, componentCanBeDefinedAssignment, + componentCanBeDefinedAssignment); } break; } @@ -272,8 +404,7 @@ } } } else { // intrinsic type, intrinsic assignment - if (to.rank() == from.rank() && to.IsContiguous() && from.IsContiguous()) { - // Everything is contiguous; do a single big copy + if (isSimpleMemmove) { std::memmove( to.raw().base_addr, from.raw().base_addr, toElements * elementBytes); } else { // elemental copies @@ -284,6 +415,9 @@ } } } + if (deferDeallocation) { + deferDeallocation->Destroy(); + } } void DoFromSourceAssign( @@ -300,7 +434,8 @@ alloc.IncrementSubscripts(allocAt)) { Descriptor allocElement{*Descriptor::Create(*allocDerived, reinterpret_cast(alloc.Element(allocAt)), 0)}; - Assign(allocElement, source, terminator, /*skipRealloc=*/true); + Assign(allocElement, source, terminator, /*maybeReallocate=*/false, + /*needFinalization=*/false, false, false); } } else { // intrinsic type for (std::size_t n{alloc.Elements()}; n-- > 0; @@ -310,7 +445,8 @@ } } } else { - Assign(alloc, source, terminator, /*skipRealloc=*/true); + Assign(alloc, source, terminator, /*maybeReallocate=*/false, + /*needFinalization=*/false, false, false); } } @@ -318,7 +454,22 @@ void RTNAME(Assign)(Descriptor &to, const Descriptor &from, const char *sourceFile, int sourceLine) { Terminator terminator{sourceFile, sourceLine}; - Assign(to, from, terminator); + // 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=*/true, + /*needFinalization=*/true, + /*canBeDefinedAssignment=*/false, + /*componentCanBeDefinedAssignment=*/true); +} + +void RTNAME(AssignTemporary)(Descriptor &to, const Descriptor &from, + const char *sourceFile, int sourceLine) { + Terminator terminator{sourceFile, sourceLine}; + Assign(to, from, terminator, /*maybeReallocate=*/false, + /*needFinalization=*/false, + /*canBeDefinedAssignment=*/false, + /*componentCanBeDefinedAssignment=*/false); } } // extern "C" diff --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp --- a/flang/runtime/derived-api.cpp +++ b/flang/runtime/derived-api.cpp @@ -144,7 +144,5 @@ return false; } -// TODO: Assign() - } // extern "C" } // namespace Fortran::runtime diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp --- a/flang/runtime/pointer.cpp +++ b/flang/runtime/pointer.cpp @@ -7,7 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Runtime/pointer.h" -#include "assign.h" +#include "assign-impl.h" #include "derived.h" #include "stat.h" #include "terminator.h"