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

klausler · 2024-04-23T00:22:00Z

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.

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.

llvmbot · 2024-04-23T00:22:29Z

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-runtime

Author: Peter Klausler (klausler)

Changes

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.

Full diff: https://github.com/llvm/llvm-project/pull/89691.diff

3 Files Affected:

(modified) flang/include/flang/Runtime/numeric.h (+8)
(modified) flang/lib/Evaluate/type.cpp (+1-1)
(modified) flang/runtime/numeric.cpp (+64-15)

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);

Runtime support has been added in llvm#89691. This patch adds lowering in a similar way than `selected_int_kind` and `selected_real_kind`.

Runtime support has been added in #89691. This patch adds lowering in a similar way than `selected_int_kind` and `selected_real_kind`.

Runtime support has been added in #89691. This patch adds lowering in a similar way than `selected_int_kind`, `selected_real_kind` and `selected_logical_kind` added in #93091. Some gfortran tests can be enabled after this patch is landed. - `Fortran/gfortran/regression/selected_char_kind_1.f90` - `Fortran/gfortran/regression/selected_char_kind_4.f90`

The implementation of the runtime version of this intrinsic function in llvm#89691 was incorrect. Fix it to interpret its argument as a bit count.

klausler · 2024-05-23T23:31:10Z

The correction has been merged.

The implementation of the runtime version of this intrinsic function in #89691 was incorrect. Fix it to interpret its argument as a bit count.

klausler requested a review from vzakhari April 23, 2024 00:22

llvmbot added flang:runtime flang Flang issues not falling into any other category flang:semantics labels Apr 23, 2024

vzakhari approved these changes Apr 24, 2024

View reviewed changes

klausler merged commit 82a8c1c into llvm:main Apr 24, 2024
8 checks passed

klausler deleted the bug1566 branch April 24, 2024 21:41

This was referenced May 22, 2024

[flang] Lower selected_logical_kind to its runtime call #93091

Merged

[flang] Lower selected_char_kind to runtime call #93095

Merged

clementval added a commit that referenced this pull request May 22, 2024

[flang] Lower selected_logical_kind to its runtime call (#93091)

bdbf927

Runtime support has been added in #89691. This patch adds lowering in a similar way than `selected_int_kind` and `selected_real_kind`.

klausler mentioned this pull request May 22, 2024

[flang][runtime] Correct SELECTED_LOGICAL_KIND() #93108

Merged

klausler added a commit that referenced this pull request May 23, 2024

[flang][runtime] Correct SELECTED_LOGICAL_KIND() (#93108)

79c2a1e

The implementation of the runtime version of this intrinsic function in #89691 was incorrect. Fix it to interpret its argument as a bit count.

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

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

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

Uh oh!

klausler commented Apr 23, 2024

Uh oh!

llvmbot commented Apr 23, 2024 •

edited

Loading

Uh oh!

Uh oh!

klausler commented May 23, 2024

Uh oh!

Uh oh!

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

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

Uh oh!

Conversation

klausler commented Apr 23, 2024

Uh oh!

llvmbot commented Apr 23, 2024 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

Uh oh!

klausler commented May 23, 2024

Uh oh!

Uh oh!

llvmbot commented Apr 23, 2024 •

edited

Loading