Skip to content

[flang][runtime] Support SELECTED_CHAR_KIND, SELECTED_LOGICAL_KIND #89691

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 24, 2024
Merged

[flang][runtime] Support SELECTED_CHAR_KIND, SELECTED_LOGICAL_KIND #89691

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions flang/include/flang/Runtime/numeric.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -356,10 +356,18 @@ CppTypeFor<TypeCategory::Real, 16> RTDECL(Scale16)(
CppTypeFor<TypeCategory::Real, 16>, std::int64_t);
#endif

// SELECTED_CHAR_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedCharKind)(
const char *, int, const char *, std::size_t);

// SELECTED_INT_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKind)(
const char *, int, void *, int);

// SELECTED_LOGICAL_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedLogicalKind)(
const char *, int, void *, int);

// SELECTED_REAL_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedRealKind)(
const char *, int, void *, int, void *, int, void *, int);
Expand Down
2 changes: 1 addition & 1 deletion flang/lib/Evaluate/type.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -731,7 +731,7 @@ bool SomeKind<TypeCategory::Derived>::operator==(
return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_);
}

int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168
int SelectedCharKind(const std::string &s, int defaultKind) { // F'2023 16.9.180
auto lower{parser::ToLowerCaseLetters(s)};
auto n{lower.size()};
while (n > 0 && lower[0] == ' ') {
Expand Down
79 changes: 64 additions & 15 deletions flang/runtime/numeric.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
#include "flang/Runtime/numeric.h"
#include "numeric-templates.h"
#include "terminator.h"
#include "tools.h"
#include "flang/Common/float128.h"
#include <cfloat>
#include <climits>
Expand All @@ -18,30 +19,30 @@
namespace Fortran::runtime {

template <typename RES>
inline RT_API_ATTRS RES getIntArgValue(const char *source, int line, void *arg,
int kind, std::int64_t defaultValue, int resKind) {
inline RT_API_ATTRS RES GetIntArgValue(const char *source, int line,
const void *arg, int kind, std::int64_t defaultValue, int resKind) {
RES res;
if (!arg) {
res = static_cast<RES>(defaultValue);
} else if (kind == 1) {
res = static_cast<RES>(
*static_cast<CppTypeFor<TypeCategory::Integer, 1> *>(arg));
*static_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(arg));
} else if (kind == 2) {
res = static_cast<RES>(
*static_cast<CppTypeFor<TypeCategory::Integer, 2> *>(arg));
*static_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(arg));
} else if (kind == 4) {
res = static_cast<RES>(
*static_cast<CppTypeFor<TypeCategory::Integer, 4> *>(arg));
*static_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(arg));
} else if (kind == 8) {
res = static_cast<RES>(
*static_cast<CppTypeFor<TypeCategory::Integer, 8> *>(arg));
*static_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(arg));
#ifdef __SIZEOF_INT128__
} else if (kind == 16) {
if (resKind != 16) {
Terminator{source, line}.Crash("Unexpected integer kind in runtime");
}
res = static_cast<RES>(
*static_cast<CppTypeFor<TypeCategory::Integer, 16> *>(arg));
*static_cast<const CppTypeFor<TypeCategory::Integer, 16> *>(arg));
#endif
} else {
Terminator{source, line}.Crash("Unexpected integer kind in runtime");
Expand Down Expand Up @@ -112,6 +113,22 @@ inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(T x) {
return -1;
}

// SELECTED_LOGICAL_KIND (F'2023 16.9.182)
template <typename T>
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedLogicalKind(
T x) {
if (x <= 2) {
return 1;
} else if (x <= 4) {
return 2;
} else if (x <= 9) {
return 4;
} else if (x <= 18) {
return 8;
}
return -1;
}

// SELECTED_REAL_KIND (16.9.170)
template <typename P, typename R, typename D>
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(
Expand Down Expand Up @@ -717,40 +734,72 @@ CppTypeFor<TypeCategory::Real, 10> RTDEF(Scale10)(
}
#endif

// SELECTED_CHAR_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(
const char *source, int line, const char *x, std::size_t length) {
static const char *keywords[]{
"ASCII", "DEFAULT", "UCS-2", "ISO_10646", "UCS-4", nullptr};
switch (IdentifyValue(x, length, keywords)) {
case 0: // ASCII
case 1: // DEFAULT
return 1;
case 2: // UCS-2
return 2;
case 3: // ISO_10646
case 4: // UCS-4
return 4;
default:
return -1;
}
}
// SELECTED_INT_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(
const char *source, int line, void *x, int xKind) {
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> r =
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
#else
std::int64_t r = getIntArgValue<std::int64_t>(
std::int64_t r = GetIntArgValue<std::int64_t>(
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
#endif
return SelectedIntKind(r);
}

// SELECTED_LOGICAL_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedLogicalKind)(
const char *source, int line, void *x, int xKind) {
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> r =
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
#else
std::int64_t r = GetIntArgValue<std::int64_t>(
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
#endif
return SelectedLogicalKind(r);
}

// SELECTED_REAL_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKind)(const char *source,
int line, void *precision, int pKind, void *range, int rKind, void *radix,
int dKind) {
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> p =
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);
CppTypeFor<TypeCategory::Integer, 16> r =
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);
CppTypeFor<TypeCategory::Integer, 16> d =
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);
#else
std::int64_t p = getIntArgValue<std::int64_t>(
std::int64_t p = GetIntArgValue<std::int64_t>(
source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);
std::int64_t r = getIntArgValue<std::int64_t>(
std::int64_t r = GetIntArgValue<std::int64_t>(
source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);
std::int64_t d = getIntArgValue<std::int64_t>(
std::int64_t d = GetIntArgValue<std::int64_t>(
source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);
#endif
return SelectedRealKind(p, r, d);
Expand Down