diff options
Diffstat (limited to 'flang-rt/lib/runtime')
41 files changed, 383 insertions, 205 deletions
diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt index dc2db1d9902c..6548ec955b2b 100644 --- a/flang-rt/lib/runtime/CMakeLists.txt +++ b/flang-rt/lib/runtime/CMakeLists.txt @@ -177,6 +177,11 @@ endif () if ("${LLVM_RUNTIMES_TARGET}" MATCHES "^amdgcn|^nvptx") set(sources ${gpu_sources}) +elseif(FLANG_RT_EXPERIMENTAL_OFFLOAD_SUPPORT STREQUAL "CUDA") + # findloc.cpp has some issues with higher compute capability. Remove it + # from CUDA build until we can lower its memory footprint. + list(REMOVE_ITEM supported_sources findloc.cpp) + set(sources ${supported_sources}) else () set(sources ${supported_sources} ${host_sources} ${f128_sources}) endif () diff --git a/flang-rt/lib/runtime/array-constructor.cpp b/flang-rt/lib/runtime/array-constructor.cpp index 858fac7bf2b3..9838c69ff1f9 100644 --- a/flang-rt/lib/runtime/array-constructor.cpp +++ b/flang-rt/lib/runtime/array-constructor.cpp @@ -173,7 +173,7 @@ void RTDEF(PushArrayConstructorSimpleScalar)( AllocateOrReallocateVectorIfNeeded(vector, terminator, to.Elements(), 1); SubscriptValue subscript[1]{ to.GetDimension(0).LowerBound() + vector.nextValuePosition}; - std::memcpy(to.Element<char>(subscript), from, to.ElementBytes()); + runtime::memcpy(to.Element<char>(subscript), from, to.ElementBytes()); ++vector.nextValuePosition; } diff --git a/flang-rt/lib/runtime/assign.cpp b/flang-rt/lib/runtime/assign.cpp index 2c29a98d5a5c..b70182ccb317 100644 --- a/flang-rt/lib/runtime/assign.cpp +++ b/flang-rt/lib/runtime/assign.cpp @@ -244,7 +244,7 @@ static RT_API_ATTRS void BlankPadCharacterAssignment(Descriptor &to, for (; elements-- > 0; to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { CHAR *p{to.Element<CHAR>(toAt)}; - Fortran::runtime::memmove( + runtime::memmove( p, from.Element<std::add_const_t<CHAR>>(fromAt), fromElementBytes); p += copiedCharacters; for (auto n{padding}; n-- > 0;) { @@ -288,7 +288,7 @@ RT_API_ATTRS int AssignTicket::Begin(WorkQueue &workQueue) { if (mustDeallocateLHS) { // Convert the LHS into a temporary, then make it look deallocated. toDeallocate_ = &tempDescriptor_.descriptor(); - std::memcpy( + runtime::memcpy( reinterpret_cast<void *>(toDeallocate_), &to_, to_.SizeInBytes()); to_.set_base_addr(nullptr); if (toDerived_ && (flags_ & NeedFinalization)) { @@ -307,7 +307,7 @@ RT_API_ATTRS int AssignTicket::Begin(WorkQueue &workQueue) { auto descBytes{from_->SizeInBytes()}; Descriptor &newFrom{tempDescriptor_.descriptor()}; persist_ = true; // tempDescriptor_ state must outlive child tickets - std::memcpy(reinterpret_cast<void *>(&newFrom), from_, descBytes); + runtime::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. @@ -648,7 +648,8 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue( } } break; - case typeInfo::Component::Genre::Pointer: { + case typeInfo::Component::Genre::Pointer: + case typeInfo::Component::Genre::PointerDevice: { std::size_t componentByteSize{ this->component_->SizeInBytes(this->instance_)}; if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) { @@ -680,6 +681,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue( } } break; case typeInfo::Component::Genre::Allocatable: + case typeInfo::Component::Genre::AllocatableDevice: case typeInfo::Component::Genre::Automatic: { auto *toDesc{reinterpret_cast<Descriptor *>( this->instance_.template Element<char>(this->subscripts_) + @@ -743,22 +745,35 @@ RT_API_ATTRS void DoFromSourceAssign(Descriptor &alloc, 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) { + std::size_t allocElementBytes{alloc.ElementBytes()}; + if (const typeInfo::DerivedType *allocDerived{ + allocAddendum ? allocAddendum->derivedType() : nullptr}) { + // Handle derived type or short character source for (std::size_t n{alloc.InlineElements()}; n-- > 0; alloc.IncrementSubscripts(allocAt)) { - Descriptor allocElement{*Descriptor::Create(*allocDerived, - reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0)}; + StaticDescriptor<maxRank, true, 8 /*?*/> statDesc; + Descriptor &allocElement{statDesc.descriptor()}; + allocElement.Establish(*allocDerived, + reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0); Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct); } - } else { // intrinsic type + } else if (allocElementBytes > source.ElementBytes()) { + // Scalar expansion of short character source + for (std::size_t n{alloc.InlineElements()}; n-- > 0; + alloc.IncrementSubscripts(allocAt)) { + StaticDescriptor<maxRank, true, 8 /*?*/> statDesc; + Descriptor &allocElement{statDesc.descriptor()}; + allocElement.Establish(source.type(), allocElementBytes, + reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0); + Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct); + } + } else { // intrinsic type scalar expansion, same data size for (std::size_t n{alloc.InlineElements()}; n-- > 0; alloc.IncrementSubscripts(allocAt)) { memmoveFct(alloc.Element<char>(allocAt), source.raw().base_addr, - alloc.ElementBytes()); + allocElementBytes); } } } else { diff --git a/flang-rt/lib/runtime/character.cpp b/flang-rt/lib/runtime/character.cpp index f140d202e118..98a225dbec9f 100644 --- a/flang-rt/lib/runtime/character.cpp +++ b/flang-rt/lib/runtime/character.cpp @@ -616,8 +616,8 @@ void RTDEF(CharacterConcatenate)(Descriptor &accumulator, from.GetLowerBounds(fromAt); for (; elements-- > 0; to += newBytes, p += oldBytes, from.IncrementSubscripts(fromAt)) { - std::memcpy(to, p, oldBytes); - std::memcpy(to + oldBytes, from.Element<char>(fromAt), fromBytes); + runtime::memcpy(to, p, oldBytes); + runtime::memcpy(to + oldBytes, from.Element<char>(fromAt), fromBytes); } FreeMemory(old); } @@ -698,7 +698,7 @@ void RTDEF(CharacterCompare)( std::size_t RTDEF(CharacterAppend1)(char *lhs, std::size_t lhsBytes, std::size_t offset, const char *rhs, std::size_t rhsBytes) { if (auto n{std::min(lhsBytes - offset, rhsBytes)}) { - std::memcpy(lhs + offset, rhs, n); + runtime::memcpy(lhs + offset, rhs, n); offset += n; } return offset; @@ -706,7 +706,7 @@ std::size_t RTDEF(CharacterAppend1)(char *lhs, std::size_t lhsBytes, void RTDEF(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset) { if (bytes > offset) { - std::memset(lhs + offset, ' ', bytes - offset); + runtime::memset(lhs + offset, ' ', bytes - offset); } } @@ -838,7 +838,7 @@ void RTDEF(Repeat)(Descriptor &result, const Descriptor &string, } const char *from{string.OffsetElement()}; for (char *to{result.OffsetElement()}; ncopies-- > 0; to += origBytes) { - std::memcpy(to, from, origBytes); + runtime::memcpy(to, from, origBytes); } } diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp index a4e8e31ad027..6b5d7722d9eb 100644 --- a/flang-rt/lib/runtime/command.cpp +++ b/flang-rt/lib/runtime/command.cpp @@ -58,7 +58,7 @@ static std::int64_t StringLength(const char *string) { static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) { if (offset < value.ElementBytes()) { - std::memset( + runtime::memset( value.OffsetElement(offset), ' ', value.ElementBytes() - offset); } } diff --git a/flang-rt/lib/runtime/copy.cpp b/flang-rt/lib/runtime/copy.cpp index f990f46e0be6..8b7db61b014e 100644 --- a/flang-rt/lib/runtime/copy.cpp +++ b/flang-rt/lib/runtime/copy.cpp @@ -12,6 +12,8 @@ #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/type-info.h" #include "flang/Runtime/allocatable.h" +#include "flang/Runtime/freestanding-tools.h" + #include <cstring> namespace Fortran::runtime { @@ -101,7 +103,7 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[], char *toPtr{to.Element<char>(toAt)}; char *fromPtr{from.Element<char>(fromAt)}; RUNTIME_CHECK(terminator, to.ElementBytes() == from.ElementBytes()); - std::memcpy(toPtr, fromPtr, to.ElementBytes()); + runtime::memcpy(toPtr, fromPtr, to.ElementBytes()); return; } @@ -148,7 +150,7 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[], // Moreover, if we came here from an Component::Genre::Data component, // all the per-element copies are redundant, because the parent // has already been copied as a whole. - std::memcpy(toPtr, fromPtr, curTo.ElementBytes()); + runtime::memcpy(toPtr, fromPtr, curTo.ElementBytes()); --elements; if (elements != 0) { currentCopy.IncrementSubscripts(terminator); @@ -166,6 +168,8 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[], std::size_t nComponents{componentDesc.Elements()}; for (std::size_t j{0}; j < nComponents; ++j, ++component) { if (component->genre() == typeInfo::Component::Genre::Allocatable || + component->genre() == + typeInfo::Component::Genre::AllocatableDevice || component->genre() == typeInfo::Component::Genre::Automatic) { Descriptor &toDesc{ *reinterpret_cast<Descriptor *>(toPtr + component->offset())}; diff --git a/flang-rt/lib/runtime/derived.cpp b/flang-rt/lib/runtime/derived.cpp index 2dddf079f91d..7e5067463162 100644 --- a/flang-rt/lib/runtime/derived.cpp +++ b/flang-rt/lib/runtime/derived.cpp @@ -63,7 +63,8 @@ RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) { char *rawInstance{instance_.OffsetElement<char>()}; for (; !Componentwise::IsComplete(); SkipToNextComponent()) { char *rawComponent{rawInstance + component_->offset()}; - if (component_->genre() == typeInfo::Component::Genre::Allocatable) { + if (component_->genre() == typeInfo::Component::Genre::Allocatable || + component_->genre() == typeInfo::Component::Genre::AllocatableDevice) { Descriptor &allocDesc{*reinterpret_cast<Descriptor *>(rawComponent)}; component_->EstablishDescriptor( allocDesc, instance_, workQueue.terminator()); @@ -71,8 +72,9 @@ RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) { // Explicit initialization of data pointers and // non-allocatable non-automatic components std::size_t bytes{component_->SizeInBytes(instance_)}; - std::memcpy(rawComponent, init, bytes); - } else if (component_->genre() == typeInfo::Component::Genre::Pointer) { + runtime::memcpy(rawComponent, init, bytes); + } else if (component_->genre() == typeInfo::Component::Genre::Pointer || + component_->genre() == typeInfo::Component::Genre::PointerDevice) { // Data pointers without explicit initialization are established // so that they are valid right-hand side targets of pointer // assignment statements. @@ -108,20 +110,20 @@ RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) { chunk = done; } char *uninitialized{rawInstance + done * *stride}; - std::memcpy(uninitialized, rawInstance, chunk * *stride); + runtime::memcpy(uninitialized, rawInstance, chunk * *stride); done += chunk; } } else { for (std::size_t done{1}; done < elements_; ++done) { char *uninitialized{rawInstance + done * *stride}; - std::memcpy(uninitialized, rawInstance, elementBytes); + runtime::memcpy(uninitialized, rawInstance, elementBytes); } } } else { // one at a time with subscription for (Elementwise::Advance(); !Elementwise::IsComplete(); Elementwise::Advance()) { char *element{instance_.Element<char>(subscripts_)}; - std::memcpy(element, rawInstance, elementBytes); + runtime::memcpy(element, rawInstance, elementBytes); } } } @@ -143,7 +145,8 @@ RT_API_ATTRS int InitializeClone(const Descriptor &clone, RT_API_ATTRS int InitializeCloneTicket::Continue(WorkQueue &workQueue) { while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Allocatable) { + if (component_->genre() == typeInfo::Component::Genre::Allocatable || + component_->genre() == typeInfo::Component::Genre::AllocatableDevice) { Descriptor &origDesc{*instance_.ElementComponent<Descriptor>( subscripts_, component_->offset())}; if (origDesc.IsAllocated()) { @@ -320,7 +323,9 @@ RT_API_ATTRS int FinalizeTicket::Begin(WorkQueue &workQueue) { RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) { while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Allocatable && + if ((component_->genre() == typeInfo::Component::Genre::Allocatable || + component_->genre() == + typeInfo::Component::Genre::AllocatableDevice) && component_->category() == TypeCategory::Derived) { // Component may be polymorphic or unlimited polymorphic. Need to use the // dynamic type to check whether finalization is needed. @@ -342,6 +347,7 @@ RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) { } } } else if (component_->genre() == typeInfo::Component::Genre::Allocatable || + component_->genre() == typeInfo::Component::Genre::AllocatableDevice || component_->genre() == typeInfo::Component::Genre::Automatic) { if (const typeInfo::DerivedType *compType{component_->derivedType()}; compType && !compType->noFinalizationNeeded()) { @@ -424,7 +430,8 @@ RT_API_ATTRS int DestroyTicket::Continue(WorkQueue &workQueue) { // Contrary to finalization, the order of deallocation does not matter. while (!IsComplete()) { const auto *componentDerived{component_->derivedType()}; - if (component_->genre() == typeInfo::Component::Genre::Allocatable) { + if (component_->genre() == typeInfo::Component::Genre::Allocatable || + component_->genre() == typeInfo::Component::Genre::AllocatableDevice) { if (fixedStride_ && (!componentDerived || componentDerived->noDestructionNeeded())) { // common fast path, just deallocate in every element diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp index a60d0b90da46..e00072510aff 100644 --- a/flang-rt/lib/runtime/descriptor-io.cpp +++ b/flang-rt/lib/runtime/descriptor-io.cpp @@ -42,7 +42,7 @@ inline RT_API_ATTRS A &ExtractElement(IoStatementState &io, } // Defined formatted I/O (maybe) -static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( +static RT_API_ATTRS common::optional<bool> DefinedFormattedIo( IoStatementState &io, const Descriptor &descriptor, const typeInfo::DerivedType &derived, const typeInfo::SpecialBinding &special, @@ -50,7 +50,7 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( // Look at the next data edit descriptor. If this is list-directed I/O, the // "maxRepeat=0" argument will prevent the input from advancing over an // initial '(' that shouldn't be consumed now as the start of a real part. - Fortran::common::optional<DataEdit> peek{io.GetNextDataEdit(/*maxRepeat=*/0)}; + common::optional<DataEdit> peek{io.GetNextDataEdit(/*maxRepeat=*/0)}; if (peek && (peek->descriptor == DataEdit::DefinedDerivedType || peek->descriptor == DataEdit::ListDirected || @@ -65,7 +65,7 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( if (edit.descriptor == DataEdit::DefinedDerivedType) { ioType[0] = 'D'; ioType[1] = 'T'; - std::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars); + runtime::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars); } else { runtime::strcpy( ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED"); @@ -107,7 +107,7 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( std::int32_t unit{external->unitNumber()}; std::int32_t ioStat{IostatOk}; char ioMsg[100]; - Fortran::common::optional<std::int64_t> startPos; + common::optional<std::int64_t> startPos; if (edit.descriptor == DataEdit::DefinedDerivedType && special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) { // DT is an edit descriptor, so everything that the child @@ -170,11 +170,13 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( io.GotChar(io.InquirePos() - *startPos); } return handler.GetIoStat() == IostatOk; + } else if (peek && peek->descriptor == DataEdit::ListDirectedNullValue) { + return false; } else { // There's a defined I/O subroutine, but there's a FORMAT present and // it does not have a DT data edit descriptor, so apply default formatting // to the components of the derived type as usual. - return Fortran::common::nullopt; + return common::nullopt; } } diff --git a/flang-rt/lib/runtime/descriptor.cpp b/flang-rt/lib/runtime/descriptor.cpp index 882870a57042..5ede5f9d9f9e 100644 --- a/flang-rt/lib/runtime/descriptor.cpp +++ b/flang-rt/lib/runtime/descriptor.cpp @@ -15,6 +15,7 @@ #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/type-info.h" #include "flang/Common/type-kinds.h" +#include "flang/Runtime/freestanding-tools.h" #include <cassert> #include <cstdlib> #include <cstring> @@ -26,13 +27,13 @@ RT_OFFLOAD_API_GROUP_BEGIN RT_API_ATTRS Descriptor::Descriptor(const Descriptor &that) { *this = that; } RT_API_ATTRS Descriptor &Descriptor::operator=(const Descriptor &that) { - std::memcpy(reinterpret_cast<void *>(this), &that, that.SizeInBytes()); + runtime::memcpy(reinterpret_cast<void *>(this), &that, that.SizeInBytes()); return *this; } RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p, int rank, const SubscriptValue *extent, - ISO::CFI_attribute_t attribute, bool addendum) { + ISO::CFI_attribute_t attribute, bool addendum, int allocatorIdx) { Terminator terminator{__FILE__, __LINE__}; int cfiStatus{ISO::VerifyEstablishParameters(&raw_, p, attribute, t.raw(), elementBytes, rank, extent, /*external=*/false)}; @@ -59,6 +60,7 @@ RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes, if (a) { new (a) DescriptorAddendum{}; } + SetAllocIdx(allocatorIdx); } RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) { @@ -70,21 +72,22 @@ RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) { RT_API_ATTRS void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute, - bool addendum) { + bool addendum, int allocatorIdx) { Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute, - addendum); + addendum, allocatorIdx); } RT_API_ATTRS void Descriptor::Establish(int characterKind, std::size_t characters, void *p, int rank, const SubscriptValue *extent, - ISO::CFI_attribute_t attribute, bool addendum) { + ISO::CFI_attribute_t attribute, bool addendum, int allocatorIdx) { Establish(TypeCode{TypeCategory::Character, characterKind}, - characterKind * characters, p, rank, extent, attribute, addendum); + characterKind * characters, p, rank, extent, attribute, addendum, + allocatorIdx); } RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank, const SubscriptValue *extent, - ISO::CFI_attribute_t attribute) { + ISO::CFI_attribute_t attribute, int allocatorIdx) { auto elementBytes{static_cast<std::size_t>(dt.sizeInBytes())}; ISO::EstablishDescriptor( &raw_, p, attribute, CFI_type_struct, elementBytes, rank, extent); @@ -98,6 +101,7 @@ RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt, } SetHasAddendum(); new (Addendum()) DescriptorAddendum{&dt}; + SetAllocIdx(allocatorIdx); } RT_API_ATTRS void Descriptor::UncheckedScalarEstablish( diff --git a/flang-rt/lib/runtime/edit-input.cpp b/flang-rt/lib/runtime/edit-input.cpp index 1bfc16cbc966..6ab546ee59f7 100644 --- a/flang-rt/lib/runtime/edit-input.cpp +++ b/flang-rt/lib/runtime/edit-input.cpp @@ -52,9 +52,9 @@ template <int LOG2_BASE> static RT_API_ATTRS bool EditBOZInput( IoStatementState &io, const DataEdit &edit, void *n, std::size_t bytes) { // Skip leading white space & zeroes - Fortran::common::optional<int> remaining{io.CueUpInput(edit)}; + common::optional<int> remaining{io.CueUpInput(edit)}; auto start{io.GetConnectionState().positionInRecord}; - Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)}; + common::optional<char32_t> next{io.NextInField(remaining, edit)}; if (next.value_or('?') == '0') { do { start = io.GetConnectionState().positionInRecord; @@ -110,7 +110,7 @@ static RT_API_ATTRS bool EditBOZInput( io.HandleAbsolutePosition(start); remaining.reset(); // Make a second pass now that the digit count is known - std::memset(n, 0, bytes); + runtime::memset(n, 0, bytes); int increment{isHostLittleEndian ? -1 : 1}; auto *data{reinterpret_cast<unsigned char *>(n) + (isHostLittleEndian ? significantBytes - 1 : bytes - significantBytes)}; @@ -154,8 +154,8 @@ static RT_API_ATTRS bool EditBOZInput( // Prepares input from a field, and returns the sign, if any, else '\0'. static RT_API_ATTRS char ScanNumericPrefix(IoStatementState &io, - const DataEdit &edit, Fortran::common::optional<char32_t> &next, - Fortran::common::optional<int> &remaining, + const DataEdit &edit, common::optional<char32_t> &next, + common::optional<int> &remaining, IoStatementState::FastAsciiField *fastField = nullptr) { remaining = io.CueUpInput(edit, fastField); next = io.NextInField(remaining, edit, fastField); @@ -202,8 +202,8 @@ RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit, edit.descriptor); return false; } - Fortran::common::optional<int> remaining; - Fortran::common::optional<char32_t> next; + common::optional<int> remaining; + common::optional<char32_t> next; auto fastField{io.GetUpcomingFastAsciiField()}; char sign{ScanNumericPrefix(io, edit, next, remaining, &fastField)}; if (sign == '-' && !isSigned) { @@ -283,18 +283,18 @@ RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit, auto shft{static_cast<int>(sizeof value - kind)}; if (!isHostLittleEndian && shft >= 0) { auto shifted{value << (8 * shft)}; - std::memcpy(n, &shifted, kind); + runtime::memcpy(n, &shifted, kind); } else { - std::memcpy(n, &value, kind); // a blank field means zero + runtime::memcpy(n, &value, kind); // a blank field means zero } #else auto shft{static_cast<int>(sizeof(value.low())) - kind}; // For kind==8 (i.e. shft==0), the value is stored in low_ in big endian. if (!isHostLittleEndian && shft >= 0) { auto l{value.low() << (8 * shft)}; - std::memcpy(n, &l, kind); + runtime::memcpy(n, &l, kind); } else { - std::memcpy(n, &value, kind); // a blank field means zero + runtime::memcpy(n, &value, kind); // a blank field means zero } #endif io.GotChar(fastField.got()); @@ -318,10 +318,10 @@ struct ScannedRealInput { }; static RT_API_ATTRS ScannedRealInput ScanRealInput( char *buffer, int bufferSize, IoStatementState &io, const DataEdit &edit) { - Fortran::common::optional<int> remaining; - Fortran::common::optional<char32_t> next; + common::optional<int> remaining; + common::optional<char32_t> next; int got{0}; - Fortran::common::optional<int> radixPointOffset; + common::optional<int> radixPointOffset; // The following lambda definition violates the conding style, // but cuda-11.8 nvcc hits an internal error with the brace initialization. auto Put = [&](char ch) -> void { @@ -938,8 +938,8 @@ RT_API_ATTRS bool EditLogicalInput( edit.descriptor); return false; } - Fortran::common::optional<int> remaining{io.CueUpInput(edit)}; - Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)}; + common::optional<int> remaining{io.CueUpInput(edit)}; + common::optional<char32_t> next{io.NextInField(remaining, edit)}; if (next && *next == '.') { // skip optional period next = io.NextInField(remaining, edit); } @@ -1121,7 +1121,7 @@ RT_API_ATTRS bool EditCharacterInput(IoStatementState &io, const DataEdit &edit, --skipChars; } else { char32_t buffer{0}; - std::memcpy(&buffer, input, chunkBytes); + runtime::memcpy(&buffer, input, chunkBytes); if ((sizeof *x == 1 && buffer > 0xff) || (sizeof *x == 2 && buffer > 0xffff)) { *x++ = '?'; @@ -1148,7 +1148,7 @@ RT_API_ATTRS bool EditCharacterInput(IoStatementState &io, const DataEdit &edit, chunkBytes = std::min<std::size_t>(remainingChars, readyBytes); chunkBytes = std::min<std::size_t>(lengthChars, chunkBytes); chunkChars = chunkBytes; - std::memcpy(x, input, chunkBytes); + runtime::memcpy(x, input, chunkBytes); x += chunkBytes; lengthChars -= chunkChars; } diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp index 0f0564403c0e..97ac56236e79 100644 --- a/flang-rt/lib/runtime/environment.cpp +++ b/flang-rt/lib/runtime/environment.cpp @@ -29,6 +29,22 @@ RT_VAR_ATTRS ExecutionEnvironment executionEnvironment; RT_OFFLOAD_VAR_GROUP_END #endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS +// Optional callback routines to be invoked pre and post execution +// environment setup. +// RTNAME(RegisterConfigureEnv) will return true if callback function(s) +// is(are) successfully added to small array of pointers. False if more +// than nConfigEnvCallback registrations for either pre or post functions. + +static int nPreConfigEnvCallback{0}; +static void (*PreConfigEnvCallback[ExecutionEnvironment::nConfigEnvCallback])( + int, const char *[], const char *[], const EnvironmentDefaultList *){ + nullptr}; + +static int nPostConfigEnvCallback{0}; +static void (*PostConfigEnvCallback[ExecutionEnvironment::nConfigEnvCallback])( + int, const char *[], const char *[], const EnvironmentDefaultList *){ + nullptr}; + static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) { if (!envDefaults) { return; @@ -52,8 +68,7 @@ static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) { } RT_OFFLOAD_API_GROUP_BEGIN -Fortran::common::optional<Convert> GetConvertFromString( - const char *x, std::size_t n) { +common::optional<Convert> GetConvertFromString(const char *x, std::size_t n) { static const char *keywords[]{ "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr}; switch (IdentifyValue(x, n, keywords)) { @@ -68,7 +83,7 @@ Fortran::common::optional<Convert> GetConvertFromString( case 4: return Convert::Swap; default: - return Fortran::common::nullopt; + return common::nullopt; } } RT_OFFLOAD_API_GROUP_END @@ -78,6 +93,15 @@ void ExecutionEnvironment::Configure(int ac, const char *av[], argc = ac; argv = av; SetEnvironmentDefaults(envDefaults); + + if (0 != nPreConfigEnvCallback) { + // Run an optional callback function after the core of the + // ExecutionEnvironment() logic. + for (int i{0}; i != nPreConfigEnvCallback; ++i) { + PreConfigEnvCallback[i](ac, av, env, envDefaults); + } + } + #ifdef _WIN32 envp = _environ; #else @@ -173,6 +197,14 @@ void ExecutionEnvironment::Configure(int ac, const char *av[], } // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment + + if (0 != nPostConfigEnvCallback) { + // Run an optional callback function in reverse order of registration + // after the core of the ExecutionEnvironment() logic. + for (int i{0}; i != nPostConfigEnvCallback; ++i) { + PostConfigEnvCallback[i](ac, av, env, envDefaults); + } + } } const char *ExecutionEnvironment::GetEnv( @@ -249,4 +281,36 @@ std::int32_t ExecutionEnvironment::UnsetEnv( return status; } +extern "C" { + +// User supplied callback functions to further customize the configuration +// of the runtime environment. +// The pre and post callback functions are called upon entry and exit +// of ExecutionEnvironment::Configure() respectively. + +bool RTNAME(RegisterConfigureEnv)( + ExecutionEnvironment::ConfigEnvCallbackPtr pre, + ExecutionEnvironment::ConfigEnvCallbackPtr post) { + bool ret{true}; + + if (nullptr != pre) { + if (nPreConfigEnvCallback < ExecutionEnvironment::nConfigEnvCallback) { + PreConfigEnvCallback[nPreConfigEnvCallback++] = pre; + } else { + ret = false; + } + } + + if (ret && nullptr != post) { + if (nPostConfigEnvCallback < ExecutionEnvironment::nConfigEnvCallback) { + PostConfigEnvCallback[nPostConfigEnvCallback++] = post; + } else { + ret = false; + } + } + + return ret; +} +} // extern "C" + } // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp index a24810b4f344..be0eed6f49dc 100644 --- a/flang-rt/lib/runtime/extensions.cpp +++ b/flang-rt/lib/runtime/extensions.cpp @@ -148,7 +148,7 @@ uid_t RTNAME(GetUID)() { void GetUsernameEnvVar(const char *envName, char *arg, std::int64_t length) { Descriptor name{*Descriptor::Create( - 1, std::strlen(envName) + 1, const_cast<char *>(envName), 0)}; + 1, runtime::strlen(envName) + 1, const_cast<char *>(envName), 0)}; Descriptor value{*Descriptor::Create(1, length, arg, 0)}; RTNAME(GetEnvVariable) @@ -172,7 +172,7 @@ void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) { char str[26]; // Insufficient space, fill with spaces and return. if (length < 24) { - std::memset(arg, ' ', length); + runtime::memset(arg, ' ', length); return; } @@ -204,8 +204,8 @@ void FORTRAN_PROCEDURE_NAME(getarg)( void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) { #if _REENTRANT || _POSIX_C_SOURCE >= 199506L if (length >= 1 && getlogin_r(arg, length) == 0) { - auto loginLen{std::strlen(arg)}; - std::memset( + auto loginLen{runtime::strlen(arg)}; + runtime::memset( arg + loginLen, ' ', static_cast<std::size_t>(length) - loginLen); return; } @@ -259,7 +259,7 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name, char *newName{nullptr}; if (name[nameLength - 1] != '\0') { newName = static_cast<char *>(std::malloc(nameLength + 1)); - std::memcpy(newName, name, nameLength); + runtime::memcpy(newName, name, nameLength); newName[nameLength] = '\0'; name = newName; } diff --git a/flang-rt/lib/runtime/external-unit.cpp b/flang-rt/lib/runtime/external-unit.cpp index 42441e59d9bb..63a93c12eec5 100644 --- a/flang-rt/lib/runtime/external-unit.cpp +++ b/flang-rt/lib/runtime/external-unit.cpp @@ -122,7 +122,7 @@ bool ExternalFileUnit::OpenUnit(common::optional<OpenStatus> status, bool impliedClose{false}; if (IsConnected()) { bool isSamePath{newPath.get() && path() && pathLength() == newPathLength && - std::memcmp(path(), newPath.get(), newPathLength) == 0}; + runtime::memcmp(path(), newPath.get(), newPathLength) == 0}; if (status && *status != OpenStatus::Old && isSamePath) { handler.SignalError("OPEN statement for connected unit may not have " "explicit STATUS= other than 'OLD'"); @@ -202,8 +202,8 @@ bool ExternalFileUnit::OpenAnonymousUnit(common::optional<OpenStatus> status, std::size_t pathMaxLen{32}; auto path{SizedNew<char>{handler}(pathMaxLen)}; std::snprintf(path.get(), pathMaxLen, "fort.%d", unitNumber_); - OpenUnit(status, action, position, std::move(path), std::strlen(path.get()), - convert, handler); + OpenUnit(status, action, position, std::move(path), + runtime::strlen(path.get()), convert, handler); return IsConnected(); } diff --git a/flang-rt/lib/runtime/extrema.cpp b/flang-rt/lib/runtime/extrema.cpp index 03e574a8fbff..9846529665e8 100644 --- a/flang-rt/lib/runtime/extrema.cpp +++ b/flang-rt/lib/runtime/extrema.cpp @@ -428,7 +428,7 @@ inline RT_API_ATTRS void TypedPartialMaxOrMinLoc(const char *intrinsic, CreatePartialReductionResult(result, x, Descriptor::BytesFor(TypeCategory::Integer, kind), dim, terminator, intrinsic, TypeCode{TypeCategory::Integer, kind}); - std::memset( + runtime::memset( result.OffsetElement(), 0, result.Elements() * result.ElementBytes()); return; } @@ -584,11 +584,11 @@ public: static_assert(std::is_same_v<A, Type>); std::size_t byteSize{array_.ElementBytes()}; if (extremum_) { - std::memcpy(p, extremum_, byteSize); + runtime::memcpy(p, extremum_, byteSize); } else { // Empty array; fill with character 0 for MAXVAL. // For MINVAL, set all of the bits. - std::memset(p, IS_MAXVAL ? 0 : 255, byteSize); + runtime::memset(p, IS_MAXVAL ? 0 : 255, byteSize); } } RT_API_ATTRS bool Accumulate(const Type *x) { diff --git a/flang-rt/lib/runtime/internal-unit.cpp b/flang-rt/lib/runtime/internal-unit.cpp index e344b01e8b34..cdcee2daaec4 100644 --- a/flang-rt/lib/runtime/internal-unit.cpp +++ b/flang-rt/lib/runtime/internal-unit.cpp @@ -72,7 +72,7 @@ RT_API_ATTRS bool InternalDescriptorUnit<DIR>::Emit( BlankFill(record + furthestPositionInRecord, positionInRecord - furthestPositionInRecord); } - std::memcpy(record + positionInRecord, data, bytes); + runtime::memcpy(record + positionInRecord, data, bytes); positionInRecord += bytes; furthestPositionInRecord = furthestAfter; return ok; diff --git a/flang-rt/lib/runtime/io-api-common.h b/flang-rt/lib/runtime/io-api-common.h index b91ff9ff1686..ad6e79d74724 100644 --- a/flang-rt/lib/runtime/io-api-common.h +++ b/flang-rt/lib/runtime/io-api-common.h @@ -31,7 +31,7 @@ static inline RT_API_ATTRS Cookie NoopUnit(const Terminator &terminator, } static inline RT_API_ATTRS ExternalFileUnit *GetOrCreateUnit(int unitNumber, - Direction direction, Fortran::common::optional<bool> isUnformatted, + Direction direction, common::optional<bool> isUnformatted, const Terminator &terminator, Cookie &errorCookie) { IoErrorHandler handler{terminator}; handler.HasIoStat(); diff --git a/flang-rt/lib/runtime/io-api.cpp b/flang-rt/lib/runtime/io-api.cpp index c7c15e77c077..da324f392e00 100644 --- a/flang-rt/lib/runtime/io-api.cpp +++ b/flang-rt/lib/runtime/io-api.cpp @@ -386,8 +386,8 @@ Cookie IODEF(BeginEndfile)( Terminator terminator{sourceFile, sourceLine}; Cookie errorCookie{nullptr}; if (ExternalFileUnit * - unit{GetOrCreateUnit(unitNumber, Direction::Output, - Fortran::common::nullopt, terminator, errorCookie)}) { + unit{GetOrCreateUnit(unitNumber, Direction::Output, common::nullopt, + terminator, errorCookie)}) { if (ChildIo * child{unit->GetChildIo()}) { return &child->BeginIoStatement<ErroneousIoStatementState>( IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile, @@ -406,8 +406,8 @@ Cookie IODEF(BeginRewind)( Terminator terminator{sourceFile, sourceLine}; Cookie errorCookie{nullptr}; if (ExternalFileUnit * - unit{GetOrCreateUnit(unitNumber, Direction::Input, - Fortran::common::nullopt, terminator, errorCookie)}) { + unit{GetOrCreateUnit(unitNumber, Direction::Input, common::nullopt, + terminator, errorCookie)}) { if (ChildIo * child{unit->GetChildIo()}) { return &child->BeginIoStatement<ErroneousIoStatementState>( IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile, @@ -732,7 +732,7 @@ bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) { io.GetIoErrorHandler().Crash( "SetAction() called after GetNewUnit() for an OPEN statement"); } - Fortran::common::optional<Action> action; + common::optional<Action> action; static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { case 0: diff --git a/flang-rt/lib/runtime/io-error.cpp b/flang-rt/lib/runtime/io-error.cpp index b350fb66fc25..0774b014e98f 100644 --- a/flang-rt/lib/runtime/io-error.cpp +++ b/flang-rt/lib/runtime/io-error.cpp @@ -153,7 +153,7 @@ bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) { } else if (ok) { std::size_t copied{Fortran::runtime::strlen(buffer)}; if (copied < bufferLength) { - std::memset(buffer + copied, ' ', bufferLength - copied); + runtime::memset(buffer + copied, ' ', bufferLength - copied); } return true; } else { diff --git a/flang-rt/lib/runtime/io-stmt.cpp b/flang-rt/lib/runtime/io-stmt.cpp index 28149090eb16..e260c0ca7511 100644 --- a/flang-rt/lib/runtime/io-stmt.cpp +++ b/flang-rt/lib/runtime/io-stmt.cpp @@ -46,9 +46,9 @@ bool IoStatementBase::Receive(char *, std::size_t, std::size_t) { return false; } -Fortran::common::optional<DataEdit> IoStatementBase::GetNextDataEdit( +common::optional<DataEdit> IoStatementBase::GetNextDataEdit( IoStatementState &, int) { - return Fortran::common::nullopt; + return common::nullopt; } bool IoStatementBase::BeginReadingRecord() { return true; } @@ -532,7 +532,7 @@ int ExternalFormattedIoStatementState<DIR, CHAR>::EndIoStatement() { return ExternalIoStatementState<DIR>::EndIoStatement(); } -Fortran::common::optional<DataEdit> IoStatementState::GetNextDataEdit(int n) { +common::optional<DataEdit> IoStatementState::GetNextDataEdit(int n) { return common::visit( [&](auto &x) { return x.get().GetNextDataEdit(*this, n); }, u_); } @@ -618,13 +618,13 @@ ExternalFileUnit *IoStatementState::GetExternalFileUnit() const { [](auto &x) { return x.get().GetExternalFileUnit(); }, u_); } -Fortran::common::optional<char32_t> IoStatementState::GetCurrentCharSlow( +common::optional<char32_t> IoStatementState::GetCurrentCharSlow( std::size_t &byteCount) { const char *p{nullptr}; std::size_t bytes{GetNextInputBytes(p)}; if (bytes == 0) { byteCount = 0; - return Fortran::common::nullopt; + return common::nullopt; } else { const ConnectionState &connection{GetConnectionState()}; if (connection.isUTF8) { @@ -661,8 +661,8 @@ IoStatementState::FastAsciiField IoStatementState::GetUpcomingFastAsciiField() { return FastAsciiField{connection}; } -Fortran::common::optional<char32_t> IoStatementState::NextInField( - Fortran::common::optional<int> &remaining, const DataEdit &edit, +common::optional<char32_t> IoStatementState::NextInField( + common::optional<int> &remaining, const DataEdit &edit, FastAsciiField *field) { std::size_t byteCount{0}; if (!remaining) { // Stream, list-directed, NAMELIST, &c. @@ -680,21 +680,21 @@ Fortran::common::optional<char32_t> IoStatementState::NextInField( case '"': case '*': case '\n': // for stream access - return Fortran::common::nullopt; + return common::nullopt; case '&': case '$': if (edit.IsNamelist()) { - return Fortran::common::nullopt; + return common::nullopt; } break; case ',': if (!(edit.modes.editingFlags & decimalComma)) { - return Fortran::common::nullopt; + return common::nullopt; } break; case ';': if (edit.modes.editingFlags & decimalComma) { - return Fortran::common::nullopt; + return common::nullopt; } break; default: @@ -712,7 +712,7 @@ Fortran::common::optional<char32_t> IoStatementState::NextInField( } else if (*remaining > 0) { if (auto next{GetCurrentChar(byteCount, field)}) { if (byteCount > static_cast<std::size_t>(*remaining)) { - return Fortran::common::nullopt; + return common::nullopt; } *remaining -= byteCount; if (field) { @@ -726,10 +726,10 @@ Fortran::common::optional<char32_t> IoStatementState::NextInField( if (CheckForEndOfRecord(0, field ? field->connection() : GetConnectionState())) { // do padding --*remaining; - return Fortran::common::optional<char32_t>{' '}; + return common::optional<char32_t>{' '}; } } - return Fortran::common::nullopt; + return common::nullopt; } bool IoStatementState::CheckForEndOfRecord( @@ -821,7 +821,7 @@ bool ListDirectedStatementState<Direction::Output>::EmitLeadingSpaceOrAdvance( return true; } -Fortran::common::optional<DataEdit> +common::optional<DataEdit> ListDirectedStatementState<Direction::Output>::GetNextDataEdit( IoStatementState &io, int maxRepeat) { DataEdit edit; @@ -838,7 +838,7 @@ int ListDirectedStatementState<Direction::Input>::EndIoStatement() { return IostatOk; } -Fortran::common::optional<DataEdit> +common::optional<DataEdit> ListDirectedStatementState<Direction::Input>::GetNextDataEdit( IoStatementState &io, int maxRepeat) { // N.B. list-directed transfers cannot be nonadvancing (C1221) @@ -891,7 +891,7 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit( } eatComma_ = true; if (!ch) { - return Fortran::common::nullopt; + return common::nullopt; } if (*ch == '/') { hitSlash_ = true; @@ -1076,6 +1076,14 @@ void ChildFormattedIoStatementState<DIR, CHAR>::CompleteOperation() { template <Direction DIR, typename CHAR> int ChildFormattedIoStatementState<DIR, CHAR>::EndIoStatement() { + if constexpr (DIR == Direction::Input) { + if (auto *listInput{this->child() + .parent() + .template get_if< + ListDirectedStatementState<Direction::Input>>()}) { + listInput->set_eatComma(false); + } + } CompleteOperation(); return ChildIoStatementState<DIR>::EndIoStatement(); } @@ -1097,6 +1105,7 @@ ChildListIoStatementState<DIR>::ChildListIoStatementState( if constexpr (DIR == Direction::Input) { if (auto *listInput{child.parent() .get_if<ListDirectedStatementState<Direction::Input>>()}) { + this->set_eatComma(listInput->eatComma()); this->namelistGroup_ = listInput->namelistGroup(); } } @@ -1121,6 +1130,13 @@ bool ChildListIoStatementState<DIR>::AdvanceRecord(int n) { template <Direction DIR> int ChildListIoStatementState<DIR>::EndIoStatement() { if constexpr (DIR == Direction::Input) { + if (auto *listInput{this->child() + .parent() + .template get_if< + ListDirectedStatementState<Direction::Input>>()}) { + listInput->set_eatComma(this->eatComma()); + listInput->set_hitSlash(this->hitSlash()); + } if (int status{ListDirectedStatementState<DIR>::EndIoStatement()}; status != IostatOk) { return status; diff --git a/flang-rt/lib/runtime/matmul-transpose.cpp b/flang-rt/lib/runtime/matmul-transpose.cpp index c9e21502b629..789f13c585ec 100644 --- a/flang-rt/lib/runtime/matmul-transpose.cpp +++ b/flang-rt/lib/runtime/matmul-transpose.cpp @@ -62,7 +62,7 @@ inline static RT_API_ATTRS void MatrixTransposedTimesMatrix( std::size_t yColumnByteStride = 0) { using ResultType = CppTypeFor<RCAT, RKIND>; - std::memset(product, 0, rows * cols * sizeof *product); + Fortran::runtime::memset(product, 0, rows * cols * sizeof *product); for (SubscriptValue j{0}; j < cols; ++j) { for (SubscriptValue i{0}; i < rows; ++i) { for (SubscriptValue k{0}; k < n; ++k) { @@ -132,7 +132,7 @@ inline static RT_API_ATTRS void MatrixTransposedTimesVector( SubscriptValue n, const XT *RESTRICT x, const YT *RESTRICT y, std::size_t xColumnByteStride = 0) { using ResultType = CppTypeFor<RCAT, RKIND>; - std::memset(product, 0, rows * sizeof *product); + Fortran::runtime::memset(product, 0, rows * sizeof *product); for (SubscriptValue i{0}; i < rows; ++i) { for (SubscriptValue k{0}; k < n; ++k) { ResultType x_ki; diff --git a/flang-rt/lib/runtime/matmul.cpp b/flang-rt/lib/runtime/matmul.cpp index 5acb34572521..d409cb1458c9 100644 --- a/flang-rt/lib/runtime/matmul.cpp +++ b/flang-rt/lib/runtime/matmul.cpp @@ -81,7 +81,7 @@ inline RT_API_ATTRS void MatrixTimesMatrix( SubscriptValue n, std::size_t xColumnByteStride = 0, std::size_t yColumnByteStride = 0) { using ResultType = CppTypeFor<RCAT, RKIND>; - std::memset(product, 0, rows * cols * sizeof *product); + Fortran::runtime::memset(product, 0, rows * cols * sizeof *product); const XT *RESTRICT xp0{x}; for (SubscriptValue k{0}; k < n; ++k) { ResultType *RESTRICT p{product}; @@ -153,7 +153,7 @@ inline RT_API_ATTRS void MatrixTimesVector( SubscriptValue n, const XT *RESTRICT x, const YT *RESTRICT y, std::size_t xColumnByteStride = 0) { using ResultType = CppTypeFor<RCAT, RKIND>; - std::memset(product, 0, rows * sizeof *product); + Fortran::runtime::memset(product, 0, rows * sizeof *product); [[maybe_unused]] const XT *RESTRICT xp0{x}; for (SubscriptValue k{0}; k < n; ++k) { ResultType *RESTRICT p{product}; @@ -203,7 +203,7 @@ inline RT_API_ATTRS void VectorTimesMatrix( SubscriptValue cols, const XT *RESTRICT x, const YT *RESTRICT y, std::size_t yColumnByteStride = 0) { using ResultType = CppTypeFor<RCAT, RKIND>; - std::memset(product, 0, cols * sizeof *product); + Fortran::runtime::memset(product, 0, cols * sizeof *product); for (SubscriptValue k{0}; k < n; ++k) { ResultType *RESTRICT p{product}; auto xv{static_cast<ResultType>(*x++)}; diff --git a/flang-rt/lib/runtime/misc-intrinsic.cpp b/flang-rt/lib/runtime/misc-intrinsic.cpp index a8797f48fa66..4d1165f25687 100644 --- a/flang-rt/lib/runtime/misc-intrinsic.cpp +++ b/flang-rt/lib/runtime/misc-intrinsic.cpp @@ -19,7 +19,7 @@ namespace Fortran::runtime { static RT_API_ATTRS void TransferImpl(Descriptor &result, const Descriptor &source, const Descriptor &mold, const char *sourceFile, - int line, Fortran::common::optional<std::int64_t> resultExtent) { + int line, common::optional<std::int64_t> resultExtent) { int rank{resultExtent.has_value() ? 1 : 0}; std::size_t elementBytes{mold.ElementBytes()}; result.Establish(mold.type(), elementBytes, nullptr, rank, nullptr, @@ -42,14 +42,14 @@ static RT_API_ATTRS void TransferImpl(Descriptor &result, source.GetLowerBounds(sourceAt); while (resultBytes > 0 && sourceElements > 0) { std::size_t toMove{std::min(resultBytes, sourceElementBytes)}; - std::memcpy(to, source.Element<char>(sourceAt), toMove); + runtime::memcpy(to, source.Element<char>(sourceAt), toMove); to += toMove; resultBytes -= toMove; --sourceElements; source.IncrementSubscripts(sourceAt); } if (resultBytes > 0) { - std::memset(to, 0, resultBytes); + runtime::memset(to, 0, resultBytes); } } @@ -91,7 +91,7 @@ void RTDEF(Rename)(const Descriptor &path1, const Descriptor &path2, void RTDEF(Transfer)(Descriptor &result, const Descriptor &source, const Descriptor &mold, const char *sourceFile, int line) { - Fortran::common::optional<std::int64_t> elements; + common::optional<std::int64_t> elements; if (mold.rank() > 0) { if (std::size_t sourceElementBytes{ source.Elements() * source.ElementBytes()}) { diff --git a/flang-rt/lib/runtime/namelist.cpp b/flang-rt/lib/runtime/namelist.cpp index 44a8fe2de3cc..79dbe4b82292 100644 --- a/flang-rt/lib/runtime/namelist.cpp +++ b/flang-rt/lib/runtime/namelist.cpp @@ -125,11 +125,11 @@ static RT_API_ATTRS bool GetLowerCaseName(IoStatementState &io, char buffer[], return false; } -static RT_API_ATTRS Fortran::common::optional<SubscriptValue> GetSubscriptValue( +static RT_API_ATTRS common::optional<SubscriptValue> GetSubscriptValue( IoStatementState &io) { - Fortran::common::optional<SubscriptValue> value; + common::optional<SubscriptValue> value; std::size_t byteCount{0}; - Fortran::common::optional<char32_t> ch{io.GetCurrentChar(byteCount)}; + common::optional<char32_t> ch{io.GetCurrentChar(byteCount)}; bool negate{ch && *ch == '-'}; if ((ch && *ch == '+') || negate) { io.HandleRelativePosition(byteCount); @@ -146,7 +146,7 @@ static RT_API_ATTRS Fortran::common::optional<SubscriptValue> GetSubscriptValue( if (overflow) { io.GetIoErrorHandler().SignalError( "NAMELIST input subscript value overflow"); - return Fortran::common::nullopt; + return common::nullopt; } if (negate) { if (value) { @@ -168,7 +168,7 @@ static RT_API_ATTRS bool HandleSubscripts(IoStatementState &io, std::size_t contiguousStride{source.ElementBytes()}; bool ok{true}; std::size_t byteCount{0}; - Fortran::common::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; + common::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; char32_t comma{GetComma(io)}; for (; ch && *ch != ')'; ++j) { SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; @@ -300,9 +300,9 @@ static RT_API_ATTRS bool HandleSubstring( SubscriptValue chars{static_cast<SubscriptValue>(desc.ElementBytes()) / kind}; // Allow for blanks in substring bounds; they're nonstandard, but not // ambiguous within the parentheses. - Fortran::common::optional<SubscriptValue> lower, upper; + common::optional<SubscriptValue> lower, upper; std::size_t byteCount{0}; - Fortran::common::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; + common::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; if (ch) { if (*ch == ':') { lower = 1; @@ -364,8 +364,7 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc, // If base and component are both arrays, the component name // must be followed by subscripts; process them now. std::size_t byteCount{0}; - if (Fortran::common::optional<char32_t> next{ - io.GetNextNonBlank(byteCount)}; + if (common::optional<char32_t> next{io.GetNextNonBlank(byteCount)}; next && *next == '(') { io.HandleRelativePosition(byteCount); // skip over '(' StaticDescriptor<maxRank, true, 16> staticDesc; @@ -454,7 +453,7 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) { RUNTIME_CHECK(handler, listInput != nullptr); // Find this namelist group's header in the input io.BeginReadingRecord(); - Fortran::common::optional<char32_t> next; + common::optional<char32_t> next; char name[nameBufferSize]; RUNTIME_CHECK(handler, group.groupName != nullptr); char32_t comma{GetComma(io)}; diff --git a/flang-rt/lib/runtime/numeric.cpp b/flang-rt/lib/runtime/numeric.cpp index 37638765dc65..78f148dbc5d8 100644 --- a/flang-rt/lib/runtime/numeric.cpp +++ b/flang-rt/lib/runtime/numeric.cpp @@ -229,6 +229,24 @@ RT_API_ATTRS BTy FPowI(BTy base, ETy exp) { return result; } +// Exponentiation operator for (Unsigned ** Unsigned) cases +template <typename Ty> RT_API_ATTRS Ty UPow(Ty base, Ty exp) { + if (exp == Ty{0}) + return Ty{1}; + Ty result{1}; + while (true) { + if (exp & Ty{1}) { + result *= base; + } + exp >>= 1; + if (exp == Ty{0}) { + break; + } + base *= base; + } + return result; +} + extern "C" { RT_EXT_API_GROUP_BEGIN @@ -933,6 +951,27 @@ CppTypeFor<TypeCategory::Real, 16> RTDEF(FPow16k)( } #endif +CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(UPow1)( + CppTypeFor<TypeCategory::Unsigned, 1> b, + CppTypeFor<TypeCategory::Unsigned, 1> e) { + return UPow(b, e); +} +CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(UPow2)( + CppTypeFor<TypeCategory::Unsigned, 2> b, + CppTypeFor<TypeCategory::Unsigned, 2> e) { + return UPow(b, e); +} +CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(UPow4)( + CppTypeFor<TypeCategory::Unsigned, 4> b, + CppTypeFor<TypeCategory::Unsigned, 4> e) { + return UPow(b, e); +} +CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(UPow8)( + CppTypeFor<TypeCategory::Unsigned, 8> b, + CppTypeFor<TypeCategory::Unsigned, 8> e) { + return UPow(b, e); +} + RT_EXT_API_GROUP_END } // extern "C" } // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/pointer.cpp b/flang-rt/lib/runtime/pointer.cpp index 68db2594acdd..f8ada65541a1 100644 --- a/flang-rt/lib/runtime/pointer.cpp +++ b/flang-rt/lib/runtime/pointer.cpp @@ -267,8 +267,10 @@ bool RTDEF(PointerIsAssociatedWith)( if (!target) { return pointer.raw().base_addr != nullptr; } - if (!target->raw().base_addr || - (target->raw().type != CFI_type_struct && target->ElementBytes() == 0)) { + if (!target->raw().base_addr || target->ElementBytes() == 0 || + target->Elements() == 0) { + // F2023, 16.9.20, p5, case (v)-(vi): don't associate pointers with + // targets that have zero sized storage sequence. return false; } int rank{pointer.rank()}; diff --git a/flang-rt/lib/runtime/pseudo-unit.cpp b/flang-rt/lib/runtime/pseudo-unit.cpp index 74ce101e25fe..8887ac681976 100644 --- a/flang-rt/lib/runtime/pseudo-unit.cpp +++ b/flang-rt/lib/runtime/pseudo-unit.cpp @@ -35,8 +35,7 @@ ExternalFileUnit *ExternalFileUnit::LookUpOrCreate( } ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit, - Direction direction, Fortran::common::optional<bool>, - IoErrorHandler &handler) { + Direction direction, common::optional<bool>, IoErrorHandler &handler) { if (direction != Direction::Output) { handler.Crash("ExternalFileUnit only supports output IO"); } @@ -59,14 +58,14 @@ ExternalFileUnit &ExternalFileUnit::NewUnit(const Terminator &, bool) { Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION); } -bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status, - Fortran::common::optional<Action>, Position, OwningPtr<char> &&, - std::size_t, Convert, IoErrorHandler &handler) { +bool ExternalFileUnit::OpenUnit(common::optional<OpenStatus> status, + common::optional<Action>, Position, OwningPtr<char> &&, std::size_t, + Convert, IoErrorHandler &handler) { handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION); } -bool ExternalFileUnit::OpenAnonymousUnit(Fortran::common::optional<OpenStatus>, - Fortran::common::optional<Action>, Position, Convert convert, +bool ExternalFileUnit::OpenAnonymousUnit(common::optional<OpenStatus>, + common::optional<Action>, Position, Convert convert, IoErrorHandler &handler) { handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION); } @@ -105,13 +104,12 @@ void PseudoOpenFile::set_mayAsynchronous(bool yes) { } } -Fortran::common::optional<PseudoOpenFile::FileOffset> -PseudoOpenFile::knownSize() const { +common::optional<PseudoOpenFile::FileOffset> PseudoOpenFile::knownSize() const { Terminator{__FILE__, __LINE__}.Crash("unsupported"); } -void PseudoOpenFile::Open(OpenStatus, Fortran::common::optional<Action>, - Position, IoErrorHandler &handler) { +void PseudoOpenFile::Open( + OpenStatus, common::optional<Action>, Position, IoErrorHandler &handler) { handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION); } @@ -132,7 +130,7 @@ std::size_t PseudoOpenFile::Write(FileOffset at, const char *buffer, // TODO: use persistent string buffer that can be reallocated // as needed, and only freed at destruction of *this. auto string{SizedNew<char>{handler}(bytes + 1)}; - std::memcpy(string.get(), buffer, bytes); + runtime::memcpy(string.get(), buffer, bytes); string.get()[bytes] = '\0'; std::printf("%s", string.get()); return bytes; diff --git a/flang-rt/lib/runtime/ragged.cpp b/flang-rt/lib/runtime/ragged.cpp index dddc3ccdfd85..f28e9b5222fc 100644 --- a/flang-rt/lib/runtime/ragged.cpp +++ b/flang-rt/lib/runtime/ragged.cpp @@ -40,7 +40,7 @@ RT_API_ATTRS RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, std::size_t bytes{static_cast<std::size_t>(elementSize * size)}; header->bufferPointer = AllocateMemoryOrCrash(terminator, bytes); if (header->bufferPointer) { - std::memset(header->bufferPointer, 0, bytes); + runtime::memset(header->bufferPointer, 0, bytes); } return header; } else { diff --git a/flang-rt/lib/runtime/random.cpp b/flang-rt/lib/runtime/random.cpp index dc74f2725ed5..ee00196f6b20 100644 --- a/flang-rt/lib/runtime/random.cpp +++ b/flang-rt/lib/runtime/random.cpp @@ -28,7 +28,7 @@ namespace Fortran::runtime::random { Lock lock; Generator generator; -Fortran::common::optional<GeneratedWord> nextValue; +common::optional<GeneratedWord> nextValue; extern "C" { diff --git a/flang-rt/lib/runtime/reduce.cpp b/flang-rt/lib/runtime/reduce.cpp index 3c5e815e32d2..778600b4b4fa 100644 --- a/flang-rt/lib/runtime/reduce.cpp +++ b/flang-rt/lib/runtime/reduce.cpp @@ -79,16 +79,16 @@ public: activeTemp_ = 1 - activeTemp_; } else { activeTemp_ = 0; - std::memcpy(&*temp_[activeTemp_], operand, elementBytes_); + runtime::memcpy(&*temp_[activeTemp_], operand, elementBytes_); } return true; } template <typename A> RT_API_ATTRS void GetResult(A *to, int /*zeroBasedDim*/ = -1) { if (activeTemp_ >= 0) { - std::memcpy(to, &*temp_[activeTemp_], elementBytes_); + runtime::memcpy(to, &*temp_[activeTemp_], elementBytes_); } else if (identity_) { - std::memcpy(to, identity_, elementBytes_); + runtime::memcpy(to, identity_, elementBytes_); } else { terminator_.Crash("REDUCE() without IDENTITY= has no result"); } diff --git a/flang-rt/lib/runtime/stat.cpp b/flang-rt/lib/runtime/stat.cpp index 322b7282b702..1d4aae2e4973 100644 --- a/flang-rt/lib/runtime/stat.cpp +++ b/flang-rt/lib/runtime/stat.cpp @@ -84,10 +84,10 @@ RT_API_ATTRS int ToErrmsg(const Descriptor *errmsg, int stat) { std::size_t bufferLength{errmsg->ElementBytes()}; std::size_t msgLength{Fortran::runtime::strlen(msg)}; if (msgLength >= bufferLength) { - std::memcpy(buffer, msg, bufferLength); + runtime::memcpy(buffer, msg, bufferLength); } else { - std::memcpy(buffer, msg, msgLength); - std::memset(buffer + msgLength, ' ', bufferLength - msgLength); + runtime::memcpy(buffer, msg, msgLength); + runtime::memset(buffer + msgLength, ' ', bufferLength - msgLength); } } } diff --git a/flang-rt/lib/runtime/temporary-stack.cpp b/flang-rt/lib/runtime/temporary-stack.cpp index 3f6fd8ee15a8..4bc161f83b29 100644 --- a/flang-rt/lib/runtime/temporary-stack.cpp +++ b/flang-rt/lib/runtime/temporary-stack.cpp @@ -16,8 +16,11 @@ #include "flang/Common/ISO_Fortran_binding_wrapper.h" #include "flang/Runtime/assign.h" +RT_OFFLOAD_API_GROUP_BEGIN + namespace { +using namespace Fortran; using namespace Fortran::runtime; // the number of elements to allocate when first creating the vector @@ -97,7 +100,7 @@ void DescriptorStorage<COPY_VALUES>::resize(size_type newCapacity) { // Avoid passing a null pointer, since it would result in an undefined // behavior. if (data_ != nullptr) { - memcpy(newData, data_, capacity_ * sizeof(Descriptor *)); + runtime::memcpy(newData, data_, capacity_ * sizeof(Descriptor *)); FreeMemory(data_); } data_ = newData; @@ -181,8 +184,11 @@ inline static DescriptorStack *getDescriptorStorage(void *opaquePtr) { return static_cast<DescriptorStack *>(opaquePtr); } +RT_OFFLOAD_API_GROUP_END + namespace Fortran::runtime { extern "C" { +RT_EXT_API_GROUP_BEGIN void *RTNAME(CreateValueStack)(const char *sourceFile, int line) { return ValueStack::allocate(sourceFile, line); } @@ -222,6 +228,6 @@ void RTNAME(DescriptorAt)(void *opaquePtr, uint64_t i, Descriptor &value) { void RTNAME(DestroyDescriptorStack)(void *opaquePtr) { DescriptorStack::destroy(getDescriptorStorage(opaquePtr)); } - +RT_EXT_API_GROUP_END } // extern "C" } // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/time-intrinsic.cpp b/flang-rt/lib/runtime/time-intrinsic.cpp index 8988817a4006..a26bf1f2fa30 100644 --- a/flang-rt/lib/runtime/time-intrinsic.cpp +++ b/flang-rt/lib/runtime/time-intrinsic.cpp @@ -44,6 +44,9 @@ // should be preferred. Any other parameters required for SFINAE should have // default values provided. namespace { + +using namespace Fortran; + // Types for the dummy parameter indicating the priority of a given overload. // We will invoke our helper with an integer literal argument, so the overload // with the highest priority should have the type int. @@ -276,13 +279,13 @@ static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator, char *zone, std::size_t zoneChars, const Fortran::runtime::Descriptor *values) { if (date) { - std::memset(date, static_cast<int>(' '), dateChars); + runtime::memset(date, static_cast<int>(' '), dateChars); } if (time) { - std::memset(time, static_cast<int>(' '), timeChars); + runtime::memset(time, static_cast<int>(' '), timeChars); } if (zone) { - std::memset(zone, static_cast<int>(' '), zoneChars); + runtime::memset(zone, static_cast<int>(' '), zoneChars); } if (values) { auto typeCode{values->type().GetCategoryAndKind()}; @@ -420,7 +423,7 @@ static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date, auto copyBufferAndPad{ [&](char *dest, std::size_t destChars, std::size_t len) { auto copyLen{std::min(len, destChars)}; - std::memcpy(dest, buffer, copyLen); + runtime::memcpy(dest, buffer, copyLen); for (auto i{copyLen}; i < destChars; ++i) { dest[i] = ' '; } @@ -525,8 +528,8 @@ void RTNAME(Etime)(const Descriptor *values, const Descriptor *time, ULARGE_INTEGER userSystemTime; ULARGE_INTEGER kernelSystemTime; - memcpy(&userSystemTime, &userTime, sizeof(FILETIME)); - memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME)); + runtime::memcpy(&userSystemTime, &userTime, sizeof(FILETIME)); + runtime::memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME)); usrTime = ((double)(userSystemTime.QuadPart)) / 10000000.0; sysTime = ((double)(kernelSystemTime.QuadPart)) / 10000000.0; diff --git a/flang-rt/lib/runtime/tools.cpp b/flang-rt/lib/runtime/tools.cpp index 24d05f369fcb..03ee982d913b 100644 --- a/flang-rt/lib/runtime/tools.cpp +++ b/flang-rt/lib/runtime/tools.cpp @@ -28,7 +28,7 @@ RT_API_ATTRS OwningPtr<char> SaveDefaultCharacter( const char *s, std::size_t length, const Terminator &terminator) { if (s) { auto *p{static_cast<char *>(AllocateMemoryOrCrash(terminator, length + 1))}; - std::memcpy(p, s, length); + runtime::memcpy(p, s, length); p[length] = '\0'; return OwningPtr<char>{p}; } else { @@ -75,10 +75,10 @@ RT_API_ATTRS void ToFortranDefaultCharacter( char *to, std::size_t toLength, const char *from) { std::size_t len{Fortran::runtime::strlen(from)}; if (len < toLength) { - std::memcpy(to, from, len); - std::memset(to + len, ' ', toLength - len); + runtime::memcpy(to, from, len); + runtime::memset(to + len, ' ', toLength - len); } else { - std::memcpy(to, from, toLength); + runtime::memcpy(to, from, toLength); } } @@ -127,10 +127,10 @@ RT_API_ATTRS void ShallowCopyDiscontiguousToDiscontiguous( toIt.Advance(), fromIt.Advance()) { // typeElementBytes == 1 when P is a char - the non-specialised case if constexpr (typeElementBytes != 1) { - std::memcpy( + runtime::memcpy( toIt.template Get<P>(), fromIt.template Get<P>(), typeElementBytes); } else { - std::memcpy( + runtime::memcpy( toIt.template Get<P>(), fromIt.template Get<P>(), elementBytes); } } @@ -150,9 +150,9 @@ RT_API_ATTRS void ShallowCopyDiscontiguousToContiguous( for (std::size_t n{to.Elements()}; n-- > 0; toAt += elementBytes, fromIt.Advance()) { if constexpr (typeElementBytes != 1) { - std::memcpy(toAt, fromIt.template Get<P>(), typeElementBytes); + runtime::memcpy(toAt, fromIt.template Get<P>(), typeElementBytes); } else { - std::memcpy(toAt, fromIt.template Get<P>(), elementBytes); + runtime::memcpy(toAt, fromIt.template Get<P>(), elementBytes); } } } @@ -170,9 +170,9 @@ RT_API_ATTRS void ShallowCopyContiguousToDiscontiguous( for (std::size_t n{to.Elements()}; n-- > 0; toIt.Advance(), fromAt += elementBytes) { if constexpr (typeElementBytes != 1) { - std::memcpy(toIt.template Get<P>(), fromAt, typeElementBytes); + runtime::memcpy(toIt.template Get<P>(), fromAt, typeElementBytes); } else { - std::memcpy(toIt.template Get<P>(), fromAt, elementBytes); + runtime::memcpy(toIt.template Get<P>(), fromAt, elementBytes); } } } @@ -187,7 +187,7 @@ RT_API_ATTRS void ShallowCopyInner(const Descriptor &to, const Descriptor &from, bool toIsContiguous, bool fromIsContiguous) { if (toIsContiguous) { if (fromIsContiguous) { - std::memcpy(to.OffsetElement(), from.OffsetElement(), + runtime::memcpy(to.OffsetElement(), from.OffsetElement(), to.Elements() * to.ElementBytes()); } else { ShallowCopyDiscontiguousToContiguous<P, RANK>(to, from); @@ -277,7 +277,7 @@ RT_API_ATTRS char *EnsureNullTerminated( char *str, std::size_t length, Terminator &terminator) { if (runtime::memchr(str, '\0', length) == nullptr) { char *newCmd{(char *)AllocateMemoryOrCrash(terminator, length + 1)}; - std::memcpy(newCmd, str, length); + runtime::memcpy(newCmd, str, length); newCmd[length] = '\0'; return newCmd; } else { @@ -309,7 +309,7 @@ RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value, return ToErrmsg(errmsg, StatValueTooShort); } - std::memcpy(value.OffsetElement(offset), rawValue, toCopy); + runtime::memcpy(value.OffsetElement(offset), rawValue, toCopy); if (static_cast<std::int64_t>(rawValueLength) > toCopy) { return ToErrmsg(errmsg, StatValueTooShort); diff --git a/flang-rt/lib/runtime/transformational.cpp b/flang-rt/lib/runtime/transformational.cpp index 3df314a4e966..1869bfeb077a 100644 --- a/flang-rt/lib/runtime/transformational.cpp +++ b/flang-rt/lib/runtime/transformational.cpp @@ -115,7 +115,7 @@ static RT_API_ATTRS void DefaultInitialize( "not yet implemented: CHARACTER(KIND=%d) in EOSHIFT intrinsic", kind); } } else { - std::memset(result.raw().base_addr, 0, bytes); + runtime::memset(result.raw().base_addr, 0, bytes); } } diff --git a/flang-rt/lib/runtime/type-code.cpp b/flang-rt/lib/runtime/type-code.cpp index 8cfec9a4ec2f..9ecde012e7d1 100644 --- a/flang-rt/lib/runtime/type-code.cpp +++ b/flang-rt/lib/runtime/type-code.cpp @@ -131,7 +131,7 @@ RT_API_ATTRS TypeCode::TypeCode(TypeCategory f, int kind) { } } -RT_API_ATTRS Fortran::common::optional<std::pair<TypeCategory, int>> +RT_API_ATTRS common::optional<std::pair<TypeCategory, int>> TypeCode::GetCategoryAndKind() const { switch (raw_) { case CFI_type_signed_char: @@ -233,7 +233,7 @@ TypeCode::GetCategoryAndKind() const { case CFI_type_uint128_t: return std::make_pair(TypeCategory::Unsigned, 16); default: - return Fortran::common::nullopt; + return common::nullopt; } } diff --git a/flang-rt/lib/runtime/type-info.cpp b/flang-rt/lib/runtime/type-info.cpp index 50123f4cf321..1157dda09c41 100644 --- a/flang-rt/lib/runtime/type-info.cpp +++ b/flang-rt/lib/runtime/type-info.cpp @@ -15,7 +15,7 @@ namespace Fortran::runtime::typeInfo { RT_OFFLOAD_API_GROUP_BEGIN -RT_API_ATTRS Fortran::common::optional<TypeParameterValue> Value::GetValue( +RT_API_ATTRS common::optional<TypeParameterValue> Value::GetValue( const Descriptor *descriptor) const { switch (genre_) { case Genre::Explicit: @@ -26,9 +26,9 @@ RT_API_ATTRS Fortran::common::optional<TypeParameterValue> Value::GetValue( return addendum->LenParameterValue(value_); } } - return Fortran::common::nullopt; + return common::nullopt; default: - return Fortran::common::nullopt; + return common::nullopt; } } @@ -95,10 +95,16 @@ RT_API_ATTRS std::size_t Component::SizeInBytes( RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor, const Descriptor &container, Terminator &terminator) const { ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>( - genre_ == Genre::Allocatable ? CFI_attribute_allocatable - : genre_ == Genre::Pointer ? CFI_attribute_pointer - : CFI_attribute_other)}; + genre_ == Genre::Allocatable || genre_ == Genre::AllocatableDevice + ? CFI_attribute_allocatable + : genre_ == Genre::Pointer || genre_ == Genre::PointerDevice + ? CFI_attribute_pointer + : CFI_attribute_other)}; TypeCategory cat{category()}; + unsigned allocatorIdx{ + genre_ == Genre::AllocatableDevice || genre_ == Genre::PointerDevice + ? kDeviceAllocatorPos + : kDefaultAllocator}; if (cat == TypeCategory::Character) { std::size_t lengthInChars{0}; if (auto length{characterLen_.GetValue(&container)}) { @@ -107,19 +113,22 @@ RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor, RUNTIME_CHECK( terminator, characterLen_.genre() == Value::Genre::Deferred); } - descriptor.Establish( - kind_, lengthInChars, nullptr, rank_, nullptr, attribute); + descriptor.Establish(kind_, lengthInChars, nullptr, rank_, nullptr, + attribute, false, allocatorIdx); } else if (cat == TypeCategory::Derived) { if (const DerivedType * type{derivedType()}) { - descriptor.Establish(*type, nullptr, rank_, nullptr, attribute); + descriptor.Establish( + *type, nullptr, rank_, nullptr, attribute, allocatorIdx); } else { // unlimited polymorphic descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr, - rank_, nullptr, attribute, true); + rank_, nullptr, attribute, true, allocatorIdx); } } else { - descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute); + descriptor.Establish( + cat, kind_, nullptr, rank_, nullptr, attribute, false, allocatorIdx); } - if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) { + if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer && + genre_ != Genre::AllocatableDevice && genre_ != Genre::PointerDevice) { const typeInfo::Value *boundValues{bounds()}; RUNTIME_CHECK(terminator, boundValues != nullptr); auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())}; @@ -267,13 +276,17 @@ FILE *Component::Dump(FILE *f) const { std::fputs(" name: ", f); DumpScalarCharacter(f, name(), "Component::name"); if (genre_ == Genre::Data) { - std::fputs(" Data ", f); + std::fputs(" Data ", f); } else if (genre_ == Genre::Pointer) { - std::fputs(" Pointer ", f); + std::fputs(" Pointer ", f); + } else if (genre_ == Genre::PointerDevice) { + std::fputs(" PointerDevice ", f); } else if (genre_ == Genre::Allocatable) { - std::fputs(" Allocatable", f); + std::fputs(" Allocatable. ", f); + } else if (genre_ == Genre::AllocatableDevice) { + std::fputs(" AllocatableDevice", f); } else if (genre_ == Genre::Automatic) { - std::fputs(" Automatic ", f); + std::fputs(" Automatic ", f); } else { std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_)); } diff --git a/flang-rt/lib/runtime/unit-map.cpp b/flang-rt/lib/runtime/unit-map.cpp index 41a03f3319d6..aa475d51b164 100644 --- a/flang-rt/lib/runtime/unit-map.cpp +++ b/flang-rt/lib/runtime/unit-map.cpp @@ -30,7 +30,7 @@ void UnitMap::Initialize() { ExternalFileUnit &UnitMap::NewUnit(const Terminator &terminator) { CriticalSection critical{lock_}; Initialize(); - Fortran::common::optional<int> n{freeNewUnits_.PopValue()}; + common::optional<int> n{freeNewUnits_.PopValue()}; if (!n) { n = emergencyNewUnit_++; } @@ -118,7 +118,7 @@ ExternalFileUnit *UnitMap::Find(const char *path, std::size_t pathLen) { for (int j{0}; j < buckets_; ++j) { for (Chain *p{bucket_[j].get()}; p; p = p->next.get()) { if (p->unit.path() && p->unit.pathLength() == pathLen && - std::memcmp(p->unit.path(), path, pathLen) == 0) { + runtime::memcmp(p->unit.path(), path, pathLen) == 0) { return &p->unit; } } diff --git a/flang-rt/lib/runtime/unit.cpp b/flang-rt/lib/runtime/unit.cpp index 5f52fa2781db..da3783417f23 100644 --- a/flang-rt/lib/runtime/unit.cpp +++ b/flang-rt/lib/runtime/unit.cpp @@ -90,11 +90,11 @@ bool ExternalFileUnit::Emit(const char *data, std::size_t bytes, CheckDirectAccess(handler); WriteFrame(frameOffsetInFile_, recordOffsetInFrame_ + furthestAfter, handler); if (positionInRecord > furthestPositionInRecord) { - std::memset(Frame() + recordOffsetInFrame_ + furthestPositionInRecord, ' ', - positionInRecord - furthestPositionInRecord); + runtime::memset(Frame() + recordOffsetInFrame_ + furthestPositionInRecord, + ' ', positionInRecord - furthestPositionInRecord); } char *to{Frame() + recordOffsetInFrame_ + positionInRecord}; - std::memcpy(to, data, bytes); + runtime::memcpy(to, data, bytes); if (swapEndianness_) { SwapEndianness(to, bytes, elementBytes); } @@ -119,7 +119,8 @@ bool ExternalFileUnit::Receive(char *data, std::size_t bytes, auto need{recordOffsetInFrame_ + furthestAfter}; auto got{ReadFrame(frameOffsetInFile_, need, handler)}; if (got >= need) { - std::memcpy(data, Frame() + recordOffsetInFrame_ + positionInRecord, bytes); + runtime::memcpy( + data, Frame() + recordOffsetInFrame_ + positionInRecord, bytes); if (swapEndianness_) { SwapEndianness(data, bytes, elementBytes); } @@ -310,7 +311,8 @@ bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) { // Pad remainder of fixed length record WriteFrame( frameOffsetInFile_, recordOffsetInFrame_ + *openRecl, handler); - std::memset(Frame() + recordOffsetInFrame_ + furthestPositionInRecord, + runtime::memset( + Frame() + recordOffsetInFrame_ + furthestPositionInRecord, isUnformatted.value_or(false) ? 0 : ' ', *openRecl - furthestPositionInRecord); furthestPositionInRecord = *openRecl; @@ -839,7 +841,7 @@ void ExternalFileUnit::PopChildIo(ChildIo &child) { std::uint32_t ExternalFileUnit::ReadHeaderOrFooter(std::int64_t frameOffset) { std::uint32_t word; char *wordPtr{reinterpret_cast<char *>(&word)}; - std::memcpy(wordPtr, Frame() + frameOffset, sizeof word); + runtime::memcpy(wordPtr, Frame() + frameOffset, sizeof word); if (swapEndianness_) { SwapEndianness(wordPtr, sizeof word, sizeof word); } diff --git a/flang-rt/lib/runtime/unit.h b/flang-rt/lib/runtime/unit.h index db7cdc315184..5ea52d1907f6 100644 --- a/flang-rt/lib/runtime/unit.h +++ b/flang-rt/lib/runtime/unit.h @@ -71,10 +71,10 @@ public: // at the end of IO statement. RT_API_ATTRS bool isTerminal() const { return true; } RT_API_ATTRS bool isWindowsTextFile() const { return false; } - RT_API_ATTRS Fortran::common::optional<FileOffset> knownSize() const; + RT_API_ATTRS common::optional<FileOffset> knownSize() const; RT_API_ATTRS bool IsConnected() const { return false; } - RT_API_ATTRS void Open(OpenStatus, Fortran::common::optional<Action>, - Position, IoErrorHandler &); + RT_API_ATTRS void Open( + OpenStatus, common::optional<Action>, Position, IoErrorHandler &); RT_API_ATTRS void Predefine(int fd) {} RT_API_ATTRS void Close(CloseStatus, IoErrorHandler &); RT_API_ATTRS std::size_t Read(FileOffset, char *, std::size_t minBytes, @@ -127,8 +127,7 @@ public: static RT_API_ATTRS ExternalFileUnit *LookUpOrCreate( int unit, const Terminator &, bool &wasExtant); static RT_API_ATTRS ExternalFileUnit *LookUpOrCreateAnonymous(int unit, - Direction, Fortran::common::optional<bool> isUnformatted, - IoErrorHandler &); + Direction, common::optional<bool> isUnformatted, IoErrorHandler &); static RT_API_ATTRS ExternalFileUnit *LookUp( const char *path, std::size_t pathLen); static RT_API_ATTRS ExternalFileUnit &CreateNew(int unit, const Terminator &); @@ -139,11 +138,11 @@ public: static RT_API_ATTRS void FlushAll(IoErrorHandler &); // Returns true if an existing unit was closed - RT_API_ATTRS bool OpenUnit(Fortran::common::optional<OpenStatus>, - Fortran::common::optional<Action>, Position, OwningPtr<char> &&path, + RT_API_ATTRS bool OpenUnit(common::optional<OpenStatus>, + common::optional<Action>, Position, OwningPtr<char> &&path, std::size_t pathLength, Convert, IoErrorHandler &); - RT_API_ATTRS bool OpenAnonymousUnit(Fortran::common::optional<OpenStatus>, - Fortran::common::optional<Action>, Position, Convert, IoErrorHandler &); + RT_API_ATTRS bool OpenAnonymousUnit(common::optional<OpenStatus>, + common::optional<Action>, Position, Convert, IoErrorHandler &); RT_API_ATTRS void CloseUnit(CloseStatus, IoErrorHandler &); RT_API_ATTRS void DestroyClosed(); @@ -254,7 +253,7 @@ private: u_; // Points to the active alternative (if any) in u_ for use as a Cookie - Fortran::common::optional<IoStatementState> io_; + common::optional<IoStatementState> io_; // A stack of child I/O pseudo-units for defined I/O that have this // unit number. @@ -298,7 +297,7 @@ private: ChildUnformattedIoStatementState<Direction::Input>, InquireUnitState, ErroneousIoStatementState, ExternalMiscIoStatementState> u_; - Fortran::common::optional<IoStatementState> io_; + common::optional<IoStatementState> io_; }; RT_OFFLOAD_API_GROUP_END diff --git a/flang-rt/lib/runtime/utf.cpp b/flang-rt/lib/runtime/utf.cpp index ef9df49f24f6..4e4da72eefa3 100644 --- a/flang-rt/lib/runtime/utf.cpp +++ b/flang-rt/lib/runtime/utf.cpp @@ -56,7 +56,7 @@ std::size_t MeasurePreviousUTF8Bytes(const char *end, std::size_t limit) { } // Non-minimal encodings are accepted. -Fortran::common::optional<char32_t> DecodeUTF8(const char *p0) { +common::optional<char32_t> DecodeUTF8(const char *p0) { const std::uint8_t *p{reinterpret_cast<const std::uint8_t *>(p0)}; std::size_t bytes{MeasureUTF8Bytes(*p0)}; if (bytes == 1) { @@ -66,7 +66,7 @@ Fortran::common::optional<char32_t> DecodeUTF8(const char *p0) { for (std::size_t j{1}; j < bytes; ++j) { std::uint8_t next{p[j]}; if (next < 0x80 || next > 0xbf) { - return Fortran::common::nullopt; + return common::nullopt; } result = (result << 6) | (next & 0x3f); } @@ -74,7 +74,7 @@ Fortran::common::optional<char32_t> DecodeUTF8(const char *p0) { return static_cast<char32_t>(result); } } - return Fortran::common::nullopt; + return common::nullopt; } std::size_t EncodeUTF8(char *p0, char32_t ucs) { diff --git a/flang-rt/lib/runtime/work-queue.cpp b/flang-rt/lib/runtime/work-queue.cpp index 42dbc9064b03..9ae751ae3367 100644 --- a/flang-rt/lib/runtime/work-queue.cpp +++ b/flang-rt/lib/runtime/work-queue.cpp @@ -14,7 +14,7 @@ namespace Fortran::runtime { -#if !defined(RT_DEVICE_COMPILATION) +#if !defined(RT_DEVICE_COMPILATION) && !defined(OMP_OFFLOAD_BUILD) // FLANG_RT_DEBUG code is disabled when false. static constexpr bool enableDebugOutput{false}; #endif @@ -79,7 +79,7 @@ RT_API_ATTRS Ticket &WorkQueue::StartTicket() { last_ = newTicket; } newTicket->ticket.begun = false; -#if !defined(RT_DEVICE_COMPILATION) +#if !defined(RT_DEVICE_COMPILATION) && !defined(OMP_OFFLOAD_BUILD) if (enableDebugOutput && (executionEnvironment.internalDebugging & ExecutionEnvironment::WorkQueue)) { @@ -93,7 +93,7 @@ RT_API_ATTRS int WorkQueue::Run() { while (last_) { TicketList *at{last_}; insertAfter_ = last_; -#if !defined(RT_DEVICE_COMPILATION) +#if !defined(RT_DEVICE_COMPILATION) && !defined(OMP_OFFLOAD_BUILD) if (enableDebugOutput && (executionEnvironment.internalDebugging & ExecutionEnvironment::WorkQueue)) { @@ -102,7 +102,7 @@ RT_API_ATTRS int WorkQueue::Run() { } #endif int stat{at->ticket.Continue(*this)}; -#if !defined(RT_DEVICE_COMPILATION) +#if !defined(RT_DEVICE_COMPILATION) && !defined(OMP_OFFLOAD_BUILD) if (enableDebugOutput && (executionEnvironment.internalDebugging & ExecutionEnvironment::WorkQueue)) { |