diff --git a/flang/runtime/character.h b/flang/runtime/character.h --- a/flang/runtime/character.h +++ b/flang/runtime/character.h @@ -107,6 +107,26 @@ void RTNAME(CharacterMinLoc)(Descriptor &result, const Descriptor &x, int dim = 0, const Descriptor *mask = nullptr, int kind = sizeof(int), bool back = false, const char *sourceFile = nullptr, int sourceLine = 0); + +std::size_t RTNAME(Scan1)( + const char *, std::size_t, const char *set, std::size_t, bool back = false); +std::size_t RTNAME(Scan2)(const char16_t *, std::size_t, const char16_t *set, + std::size_t, bool back = false); +std::size_t RTNAME(Scan4)(const char32_t *, std::size_t, const char32_t *set, + std::size_t, bool back = false); +void RTNAME(Scan)(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back /*can be null*/, int kind, + const char *sourceFile = nullptr, int sourceLine = 0); + +std::size_t RTNAME(Verify1)( + const char *, std::size_t, const char *set, std::size_t, bool back = false); +std::size_t RTNAME(Verify2)(const char16_t *, std::size_t, const char16_t *set, + std::size_t, bool back = false); +std::size_t RTNAME(Verify4)(const char32_t *, std::size_t, const char32_t *set, + std::size_t, bool back = false); +void RTNAME(Verify)(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back /*can be null*/, int kind, + const char *sourceFile = nullptr, int sourceLine = 0); } } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_CHARACTER_H_ diff --git a/flang/runtime/character.cpp b/flang/runtime/character.cpp --- a/flang/runtime/character.cpp +++ b/flang/runtime/character.cpp @@ -94,7 +94,8 @@ elements *= ub[j]; xAt[j] = yAt[j] = 1; } - result.Establish(TypeCategory::Logical, 1, ub, rank); + result.Establish( + TypeCategory::Logical, 1, nullptr, rank, ub, CFI_attribute_allocatable); if (result.Allocate(lb, ub) != CFI_SUCCESS) { terminator.Crash("Compare: could not allocate storage for result"); } @@ -145,7 +146,8 @@ stringAt[j] = 1; } std::size_t elementBytes{string.ElementBytes()}; - result.Establish(string.type(), elementBytes, ub, rank); + result.Establish(string.type(), elementBytes, nullptr, rank, ub, + CFI_attribute_allocatable); if (result.Allocate(lb, ub) != CFI_SUCCESS) { terminator.Crash("ADJUSTL/R: could not allocate storage for result"); } @@ -196,7 +198,8 @@ elements *= ub[j]; stringAt[j] = 1; } - result.Establish(TypeCategory::Integer, sizeof(INT), ub, rank); + result.Establish(TypeCategory::Integer, sizeof(INT), nullptr, rank, ub, + CFI_attribute_allocatable); if (result.Allocate(lb, ub) != CFI_SUCCESS) { terminator.Crash("LEN_TRIM: could not allocate storage for result"); } @@ -232,6 +235,133 @@ } } +// SCAN and VERIFY implementation help. These intrinsic functions +// do pretty much the same thing, so they're templatized with a +// distinguishing flag. + +template +inline std::size_t ScanVerify(const CHAR *x, std::size_t xLen, const CHAR *set, + std::size_t setLen, bool back) { + std::size_t at{back ? xLen : 1}; + int increment{back ? -1 : 1}; + for (; xLen-- > 0; at += increment) { + CHAR ch{x[at - 1]}; + bool inSet{false}; + // TODO: If set is sorted, could use binary search + for (std::size_t j{0}; j < setLen; ++j) { + if (set[j] == ch) { + inSet = true; + break; + } + } + if (inSet != IS_VERIFY) { + return at; + } + } + return 0; +} + +// Specialization for one-byte characters +template +inline std::size_t ScanVerify(const char *x, std::size_t xLen, const char *set, + std::size_t setLen, bool back) { + std::size_t at{back ? xLen : 1}; + int increment{back ? -1 : 1}; + if (xLen > 0) { + std::uint64_t bitSet[256 / 64]{0}; + std::uint64_t one{1}; + for (std::size_t j{0}; j < setLen; ++j) { + unsigned setCh{static_cast(set[j])}; + bitSet[setCh / 64] |= one << (setCh % 64); + } + for (; xLen-- > 0; at += increment) { + unsigned ch{static_cast(x[at - 1])}; + bool inSet{((bitSet[ch / 64] >> (ch % 64)) & 1) != 0}; + if (inSet != IS_VERIFY) { + return at; + } + } + } + return 0; +} + +static bool IsLogicalElementTrue( + const Descriptor &logical, const SubscriptValue at[]) { + // A LOGICAL value is false if and only if all of its bytes are zero. + const char *p{logical.Element(at)}; + for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) { + if (*p) { + return true; + } + } + return false; +} + +template +static void ScanVerify(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back, + const Terminator &terminator) { + int rank{string.rank() ? string.rank() + : set.rank() ? set.rank() : back ? back->rank() : 0}; + SubscriptValue lb[maxRank], ub[maxRank], stringAt[maxRank], setAt[maxRank], + backAt[maxRank]; + SubscriptValue elements{1}; + for (int j{0}; j < rank; ++j) { + lb[j] = 1; + ub[j] = string.rank() + ? string.GetDimension(j).Extent() + : set.rank() ? set.GetDimension(j).Extent() + : back ? back->GetDimension(j).Extent() : 1; + elements *= ub[j]; + stringAt[j] = setAt[j] = backAt[j] = 1; + } + result.Establish(TypeCategory::Integer, sizeof(INT), nullptr, rank, ub, + CFI_attribute_allocatable); + if (result.Allocate(lb, ub) != CFI_SUCCESS) { + terminator.Crash("SCAN/VERIFY: could not allocate storage for result"); + } + std::size_t stringElementChars{string.ElementBytes() >> shift}; + std::size_t setElementChars{set.ElementBytes() >> shift}; + for (SubscriptValue resultAt{0}; elements-- > 0; resultAt += sizeof(INT), + string.IncrementSubscripts(stringAt), set.IncrementSubscripts(setAt), + back && back->IncrementSubscripts(backAt)) { + *result.OffsetElement(resultAt) = + ScanVerify(string.Element(stringAt), + stringElementChars, set.Element(setAt), setElementChars, + back && IsLogicalElementTrue(*back, backAt)); + } +} + +template +static void ScanVerifyKind(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back, int kind, + const Terminator &terminator) { + switch (kind) { + case 1: + ScanVerify( + result, string, set, back, terminator); + break; + case 2: + ScanVerify( + result, string, set, back, terminator); + break; + case 4: + ScanVerify( + result, string, set, back, terminator); + break; + case 8: + ScanVerify( + result, string, set, back, terminator); + break; + case 16: + ScanVerify( + result, string, set, back, terminator); + break; + default: + terminator.Crash("SCAN/VERIFY: bad KIND=%d", kind); + } +} + template static void CopyAndPad( TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) { @@ -608,7 +738,7 @@ } } -// Intrinsic functions +// Intrinsic function entry points void RTNAME(AdjustL)(Descriptor &result, const Descriptor &string, const char *sourceFile, int sourceLine) { @@ -649,11 +779,47 @@ } } +std::size_t RTNAME(Scan1)(const char *x, std::size_t xLen, const char *set, + std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} +std::size_t RTNAME(Scan2)(const char16_t *x, std::size_t xLen, + const char16_t *set, std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} +std::size_t RTNAME(Scan4)(const char32_t *x, std::size_t xLen, + const char32_t *set, std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} + +void RTNAME(Scan)(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back, int kind, + const char *sourceFile, int sourceLine) { + Terminator terminator{sourceFile, sourceLine}; + switch (string.raw().type) { + case CFI_type_char: + ScanVerifyKind(result, string, set, back, kind, terminator); + break; + case CFI_type_char16_t: + ScanVerifyKind( + result, string, set, back, kind, terminator); + break; + case CFI_type_char32_t: + ScanVerifyKind( + result, string, set, back, kind, terminator); + break; + default: + terminator.Crash( + "SCAN: bad string type code %d", static_cast(string.raw().type)); + } +} + void RTNAME(Repeat)(Descriptor &result, const Descriptor &string, std::size_t ncopies, const char *sourceFile, int sourceLine) { Terminator terminator{sourceFile, sourceLine}; std::size_t origBytes{string.ElementBytes()}; - result.Establish(string.type(), origBytes * ncopies, nullptr, 0); + result.Establish(string.type(), origBytes * ncopies, nullptr, 0, nullptr, + CFI_attribute_allocatable); if (result.Allocate(nullptr, nullptr) != CFI_SUCCESS) { terminator.Crash("REPEAT could not allocate storage for result"); } @@ -692,6 +858,39 @@ std::memcpy(result.OffsetElement(), string.OffsetElement(), resultBytes); } +std::size_t RTNAME(Verify1)(const char *x, std::size_t xLen, const char *set, + std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} +std::size_t RTNAME(Verify2)(const char16_t *x, std::size_t xLen, + const char16_t *set, std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} +std::size_t RTNAME(Verify4)(const char32_t *x, std::size_t xLen, + const char32_t *set, std::size_t setLen, bool back) { + return ScanVerify(x, xLen, set, setLen, back); +} + +void RTNAME(Verify)(Descriptor &result, const Descriptor &string, + const Descriptor &set, const Descriptor *back, int kind, + const char *sourceFile, int sourceLine) { + Terminator terminator{sourceFile, sourceLine}; + switch (string.raw().type) { + case CFI_type_char: + ScanVerifyKind(result, string, set, back, kind, terminator); + break; + case CFI_type_char16_t: + ScanVerifyKind(result, string, set, back, kind, terminator); + break; + case CFI_type_char32_t: + ScanVerifyKind(result, string, set, back, kind, terminator); + break; + default: + terminator.Crash( + "VERIFY: bad string type code %d", static_cast(string.raw().type)); + } +} + void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x, const char *sourceFile, int sourceLine) { MaxMin(accumulator, x, sourceFile, sourceLine); diff --git a/flang/unittests/Runtime/character.cpp b/flang/unittests/Runtime/character.cpp --- a/flang/unittests/Runtime/character.cpp +++ b/flang/unittests/Runtime/character.cpp @@ -46,6 +46,24 @@ TestCharCompare(y, x, yBytes, xBytes, -expect); } +static void Scan( + const char *str, const char *set, bool back, std::size_t expect) { + auto res{RTNAME(Scan1)(str, std::strlen(str), set, std::strlen(set), back)}; + if (res != expect) { + Fail() << "Scan(" << str << ',' << set << ",back=" << back << "): got " + << res << ", should be " << expect << '\n'; + } +} + +static void Verify( + const char *str, const char *set, bool back, std::size_t expect) { + auto res{RTNAME(Verify1)(str, std::strlen(str), set, std::strlen(set), back)}; + if (res != expect) { + Fail() << "Verify(" << str << ',' << set << ",back=" << back << "): got " + << res << ", should be " << expect << '\n'; + } +} + int main() { StartTests(); for (std::size_t j{0}; j < 8; ++j) { @@ -55,5 +73,17 @@ Compare("abc", "def", 3, 3, -1); Compare("ab ", "abc", 3, 2, 0); Compare("abc", "abc", 2, 3, -1); + Scan("abc", "abc", false, 1); + Scan("abc", "abc", true, 3); + Scan("abc", "cde", false, 3); + Scan("abc", "cde", true, 3); + Scan("abc", "x", false, 0); + Scan("", "x", false, 0); + Verify("abc", "abc", false, 0); + Verify("abc", "abc", true, 0); + Verify("abc", "cde", false, 1); + Verify("abc", "cde", true, 2); + Verify("abc", "x", false, 1); + Verify("", "x", false, 0); return EndTests(); }