diff --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h index a1cc9eaf4355f..331ec0516dd2d 100644 --- a/flang/include/flang/Runtime/assign.h +++ b/flang/include/flang/Runtime/assign.h @@ -24,11 +24,35 @@ #define FORTRAN_RUNTIME_ASSIGN_H_ #include "flang/Runtime/entry-names.h" +#include "flang/Runtime/freestanding-tools.h" namespace Fortran::runtime { class Descriptor; +class Terminator; + +enum AssignFlags { + NoAssignFlags = 0, + MaybeReallocate = 1 << 0, + NeedFinalization = 1 << 1, + CanBeDefinedAssignment = 1 << 2, + ComponentCanBeDefinedAssignment = 1 << 3, + ExplicitLengthCharacterLHS = 1 << 4, + PolymorphicLHS = 1 << 5, + DeallocateLHS = 1 << 6 +}; + +using MemmoveFct = void *(*)(void *, const void *, std::size_t); + +static RT_API_ATTRS void *MemmoveWrapper( + void *dest, const void *src, std::size_t count) { + return Fortran::runtime::memmove(dest, src, count); +} + +RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from, + Terminator &terminator, int flags, MemmoveFct memmoveFct = &MemmoveWrapper); extern "C" { + // API for lowering assignment void RTDECL(Assign)(Descriptor &to, const Descriptor &from, const char *sourceFile = nullptr, int sourceLine = 0); diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp index d558ada51cd21..8f31fc4d12716 100644 --- a/flang/runtime/assign.cpp +++ b/flang/runtime/assign.cpp @@ -17,17 +17,6 @@ namespace Fortran::runtime { -enum AssignFlags { - NoAssignFlags = 0, - MaybeReallocate = 1 << 0, - NeedFinalization = 1 << 1, - CanBeDefinedAssignment = 1 << 2, - ComponentCanBeDefinedAssignment = 1 << 3, - ExplicitLengthCharacterLHS = 1 << 4, - PolymorphicLHS = 1 << 5, - DeallocateLHS = 1 << 6 -}; - // Predicate: is the left-hand side of an assignment an allocated allocatable // that must be deallocated? static inline RT_API_ATTRS bool MustDeallocateLHS( @@ -250,8 +239,8 @@ static RT_API_ATTRS void BlankPadCharacterAssignment(Descriptor &to, // 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 static void Assign( - Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) { +RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from, + Terminator &terminator, int flags, MemmoveFct memmoveFct) { bool mustDeallocateLHS{(flags & DeallocateLHS) || MustDeallocateLHS(to, from, terminator, flags)}; DescriptorAddendum *toAddendum{to.Addendum()}; @@ -423,14 +412,14 @@ RT_API_ATTRS static void Assign( Assign(toCompDesc, fromCompDesc, terminator, nestedFlags); } else { // Component has intrinsic type; simply copy raw bytes std::size_t componentByteSize{comp.SizeInBytes(to)}; - Fortran::runtime::memmove(to.Element(toAt) + comp.offset(), + memmoveFct(to.Element(toAt) + comp.offset(), from.Element(fromAt) + comp.offset(), componentByteSize); } break; case typeInfo::Component::Genre::Pointer: { std::size_t componentByteSize{comp.SizeInBytes(to)}; - Fortran::runtime::memmove(to.Element(toAt) + comp.offset(), + memmoveFct(to.Element(toAt) + comp.offset(), from.Element(fromAt) + comp.offset(), componentByteSize); } break; @@ -476,14 +465,14 @@ RT_API_ATTRS static void Assign( const auto &procPtr{ *procPtrDesc.ZeroBasedIndexedElement( k)}; - Fortran::runtime::memmove(to.Element(toAt) + procPtr.offset, + memmoveFct(to.Element(toAt) + procPtr.offset, from.Element(fromAt) + procPtr.offset, sizeof(typeInfo::ProcedurePointer)); } } } else { // intrinsic type, intrinsic assignment if (isSimpleMemmove()) { - Fortran::runtime::memmove(to.raw().base_addr, from.raw().base_addr, + memmoveFct(to.raw().base_addr, from.raw().base_addr, toElements * toElementBytes); } else if (toElementBytes > fromElementBytes) { // blank padding switch (to.type().raw()) { @@ -507,8 +496,8 @@ RT_API_ATTRS static void Assign( } else { // elemental copies, possibly with character truncation for (std::size_t n{toElements}; n-- > 0; to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { - Fortran::runtime::memmove(to.Element(toAt), - from.Element(fromAt), toElementBytes); + memmoveFct(to.Element(toAt), from.Element(fromAt), + toElementBytes); } } }