[flang-commits] [flang] [flang][runtime] Support SELECTED_CHAR_KIND, SELECTED_LOGICAL_KIND (PR #89691)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Apr 22 17:22:06 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/89691
Add code to the runtime support library for the SELECTED_CHAR_KIND and SELECTED_LOGICAL_KIND intrinsic functions. These are usually used with constant folding in constant expressions, but the are available for use with dynamic arguments as well.
Lowering support remains to be implemented.
>From bbfe27638f77fdbfc0b5560ee4e3870331208010 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 22 Apr 2024 16:14:52 -0700
Subject: [PATCH] [flang][runtime] Support SELECTED_CHAR_KIND,
SELECTED_LOGICAL_KIND
Add code to the runtime support library for the SELECTED_CHAR_KIND
and SELECTED_LOGICAL_KIND intrinsic functions. These are usually
used with constant folding in constant expressions, but the are
available for use with dynamic arguments as well.
Lowering support remains to be implemented.
---
flang/include/flang/Runtime/numeric.h | 8 +++
flang/lib/Evaluate/type.cpp | 2 +-
flang/runtime/numeric.cpp | 79 ++++++++++++++++++++++-----
3 files changed, 73 insertions(+), 16 deletions(-)
diff --git a/flang/include/flang/Runtime/numeric.h b/flang/include/flang/Runtime/numeric.h
index 3d9cb8b5b0acdc..7d3f91360c8cfb 100644
--- a/flang/include/flang/Runtime/numeric.h
+++ b/flang/include/flang/Runtime/numeric.h
@@ -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);
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index a369e07f94a1fb..ee1e5b398d9b02 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -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] == ' ') {
diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp
index abd3e500029fe4..52b5a56894d884 100644
--- a/flang/runtime/numeric.cpp
+++ b/flang/runtime/numeric.cpp
@@ -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>
@@ -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");
@@ -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(
@@ -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);
More information about the flang-commits
mailing list