Skip to content

Commit 82a8c1c

Browse files
klauslerklausler
authored
[flang][runtime] Support SELECTED_CHAR_KIND, SELECTED_LOGICAL_KIND (#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.
1 parent 418e4b0 commit 82a8c1c

File tree

3 files changed

+73
-16
lines changed

3 files changed

+73
-16
lines changed

‎flang/include/flang/Runtime/numeric.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -356,10 +356,18 @@ CppTypeFor<TypeCategory::Real, 16> RTDECL(Scale16)(
356356
CppTypeFor<TypeCategory::Real, 16>, std::int64_t);
357357
#endif
358358

359+
// SELECTED_CHAR_KIND
360+
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedCharKind)(
361+
const char *, int, const char *, std::size_t);
362+
359363
// SELECTED_INT_KIND
360364
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKind)(
361365
const char *, int, void *, int);
362366

367+
// SELECTED_LOGICAL_KIND
368+
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedLogicalKind)(
369+
const char *, int, void *, int);
370+
363371
// SELECTED_REAL_KIND
364372
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedRealKind)(
365373
const char *, int, void *, int, void *, int, void *, int);

‎flang/lib/Evaluate/type.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -731,7 +731,7 @@ bool SomeKind<TypeCategory::Derived>::operator==(
731731
return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_);
732732
}
733733

734-
int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168
734+
int SelectedCharKind(const std::string &s, int defaultKind) { // F'2023 16.9.180
735735
auto lower{parser::ToLowerCaseLetters(s)};
736736
auto n{lower.size()};
737737
while (n > 0 && lower[0] == ' ') {

‎flang/runtime/numeric.cpp

Lines changed: 64 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99
#include "flang/Runtime/numeric.h"
1010
#include "numeric-templates.h"
1111
#include "terminator.h"
12+
#include "tools.h"
1213
#include "flang/Common/float128.h"
1314
#include <cfloat>
1415
#include <climits>
@@ -18,30 +19,30 @@
1819
namespace Fortran::runtime {
1920

2021
template <typename RES>
21-
inline RT_API_ATTRS RES getIntArgValue(const char *source, int line, void *arg,
22-
int kind, std::int64_t defaultValue, int resKind) {
22+
inline RT_API_ATTRS RES GetIntArgValue(const char *source, int line,
23+
const void *arg, int kind, std::int64_t defaultValue, int resKind) {
2324
RES res;
2425
if (!arg) {
2526
res = static_cast<RES>(defaultValue);
2627
} else if (kind == 1) {
2728
res = static_cast<RES>(
28-
*static_cast<CppTypeFor<TypeCategory::Integer, 1> *>(arg));
29+
*static_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(arg));
2930
} else if (kind == 2) {
3031
res = static_cast<RES>(
31-
*static_cast<CppTypeFor<TypeCategory::Integer, 2> *>(arg));
32+
*static_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(arg));
3233
} else if (kind == 4) {
3334
res = static_cast<RES>(
34-
*static_cast<CppTypeFor<TypeCategory::Integer, 4> *>(arg));
35+
*static_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(arg));
3536
} else if (kind == 8) {
3637
res = static_cast<RES>(
37-
*static_cast<CppTypeFor<TypeCategory::Integer, 8> *>(arg));
38+
*static_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(arg));
3839
#ifdef __SIZEOF_INT128__
3940
} else if (kind == 16) {
4041
if (resKind != 16) {
4142
Terminator{source, line}.Crash("Unexpected integer kind in runtime");
4243
}
4344
res = static_cast<RES>(
44-
*static_cast<CppTypeFor<TypeCategory::Integer, 16> *>(arg));
45+
*static_cast<const CppTypeFor<TypeCategory::Integer, 16> *>(arg));
4546
#endif
4647
} else {
4748
Terminator{source, line}.Crash("Unexpected integer kind in runtime");
@@ -112,6 +113,22 @@ inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(T x) {
112113
return -1;
113114
}
114115

116+
// SELECTED_LOGICAL_KIND (F'2023 16.9.182)
117+
template <typename T>
118+
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedLogicalKind(
119+
T x) {
120+
if (x <= 2) {
121+
return 1;
122+
} else if (x <= 4) {
123+
return 2;
124+
} else if (x <= 9) {
125+
return 4;
126+
} else if (x <= 18) {
127+
return 8;
128+
}
129+
return -1;
130+
}
131+
115132
// SELECTED_REAL_KIND (16.9.170)
116133
template <typename P, typename R, typename D>
117134
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(
@@ -717,40 +734,72 @@ CppTypeFor<TypeCategory::Real, 10> RTDEF(Scale10)(
717734
}
718735
#endif
719736

737+
// SELECTED_CHAR_KIND
738+
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(
739+
const char *source, int line, const char *x, std::size_t length) {
740+
static const char *keywords[]{
741+
"ASCII", "DEFAULT", "UCS-2", "ISO_10646", "UCS-4", nullptr};
742+
switch (IdentifyValue(x, length, keywords)) {
743+
case 0: // ASCII
744+
case 1: // DEFAULT
745+
return 1;
746+
case 2: // UCS-2
747+
return 2;
748+
case 3: // ISO_10646
749+
case 4: // UCS-4
750+
return 4;
751+
default:
752+
return -1;
753+
}
754+
}
720755
// SELECTED_INT_KIND
721756
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(
722757
const char *source, int line, void *x, int xKind) {
723758
#ifdef __SIZEOF_INT128__
724759
CppTypeFor<TypeCategory::Integer, 16> r =
725-
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
760+
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
726761
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
727762
#else
728-
std::int64_t r = getIntArgValue<std::int64_t>(
763+
std::int64_t r = GetIntArgValue<std::int64_t>(
729764
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
730765
#endif
731766
return SelectedIntKind(r);
732767
}
733768

769+
// SELECTED_LOGICAL_KIND
770+
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedLogicalKind)(
771+
const char *source, int line, void *x, int xKind) {
772+
#ifdef __SIZEOF_INT128__
773+
CppTypeFor<TypeCategory::Integer, 16> r =
774+
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
775+
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
776+
#else
777+
std::int64_t r = GetIntArgValue<std::int64_t>(
778+
source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
779+
#endif
780+
return SelectedLogicalKind(r);
781+
}
782+
734783
// SELECTED_REAL_KIND
735784
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKind)(const char *source,
736785
int line, void *precision, int pKind, void *range, int rKind, void *radix,
737786
int dKind) {
738787
#ifdef __SIZEOF_INT128__
739788
CppTypeFor<TypeCategory::Integer, 16> p =
740-
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
789+
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
741790
source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);
742791
CppTypeFor<TypeCategory::Integer, 16> r =
743-
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
792+
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
744793
source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);
745794
CppTypeFor<TypeCategory::Integer, 16> d =
746-
getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
795+
GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
747796
source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);
748797
#else
749-
std::int64_t p = getIntArgValue<std::int64_t>(
798+
std::int64_t p = GetIntArgValue<std::int64_t>(
750799
source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);
751-
std::int64_t r = getIntArgValue<std::int64_t>(
800+
std::int64_t r = GetIntArgValue<std::int64_t>(
752801
source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);
753-
std::int64_t d = getIntArgValue<std::int64_t>(
802+
std::int64_t d = GetIntArgValue<std::int64_t>(
754803
source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);
755804
#endif
756805
return SelectedRealKind(p, r, d);

0 commit comments

Comments
 (0)