[flang] Support intrinsic `selected_int_kind` for variables

[peixin]

Summary

As Fortran 2018 16.9.169, the argument of selected_int_kind is integer
scalar, and result is default integer scalar. The constant expression in
this intrinsic has been supported by folding the constant expression.
This supports lowering and runtime for variables in this intrinsic.

[peixin]

Fix the bot fail on windows.

[peixin]

Trying to fix windows bot fail by adding #ifdef __SIZEOF_INT128__ in flang/lib/Optimizer/Builder/Runtime/Numeric.cpp.

[peixin]

Fix CI fail for test case by adding ! REQUIRES: shell.

[peixin]

Add #ifdef __SIZEOF_INT128__ in runtime to fix the runtime error on windows.

[jeanPerier]

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

385

To workaround the fact that the host may not support in128 but the target might, the int128 runtime interface are usually manually defined here, see ForcedRRSpacing16 for example (with floating point instead of integers).

flang/runtime/numeric.cpp

146

The result type could also be CppTypeFor<TypeCategory::Integer, 4> here regardless of T.

147

Why are you handling negative arguments as if they were positive ? I am not seeing a special case for negative R in 16.9.169.

[peixin]

Address the comments and fix two typos for intrinsic SetExponent.

[peixin]

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

385

Thanks for the direction. Fixed.

flang/runtime/numeric.cpp

146

Right. This as one typo.

147

This is to compute the abs of x. I tried std::abs, but it does work for 128 bit. I followed the classic-flang:
https://github.com/flang-compiler/flang/blob/989bae626c24cee1c2b1836ea2223c08366f68b0/runtime/flang/miscsup_com.c#L4262-L4279
https://github.com/flang-compiler/flang/blob/989bae626c24cee1c2b1836ea2223c08366f68b0/runtime/flang/util.c#L66
https://github.com/flang-compiler/flang/blob/989bae626c24cee1c2b1836ea2223c08366f68b0/runtime/flang/fioMacros.h#L563

[peixin]

Fix clang-format.

[jeanPerier]

flang/runtime/numeric.cpp

147

If I am following the classic-flang correctly, the abs call is quite different, it is made on the descriptor kind code for some reason specific to classic-flang format, not the "x" value itself.

[jeanPerier]

flang/unittests/Runtime/Numeric.cpp

124

 print *, selected_int_kind(-10)
end

gfortran, nvfortran, ifort all return 1 here, I think the abs is wrong.

[peixin]

Fix the wrong computation.

[peixin]

Thanks @jeanPerier for the correction.

flang/unittests/Runtime/Numeric.cpp

124

You are right. According to the standard, the value is in the range −pow(10, R) < n < pow(10, R) (I don't know how to type it here. In Fortran 2018 16.9.169), where R is the input argument. When R is negative, pow(10, R) is always less than 1. So, the result is 1.

[peixin]

Update the approach to follow the style of SELECTED_REAL_KIND as @jeanPerier suggested.

[jeanPerier]

LGTM, thanks

[rogfer01]

flang/lib/Lower/IntrinsicCall.cpp

926

I have a couple of small questions around here.

Does the string of the argument have to be the dummy argument name as specified in the spec? If so, in my draft of Fortran 2018 this is called r instead of scalar.

Also, why passing the argument asAddr, could it be passed asValue instead? I imagine that would require converting the value into some specific integer type before passing it to the runtime function. Do we really expect a user to pass an integer so large that forces us to cast the address to the proper integer type.

[peixin]

flang/lib/Lower/IntrinsicCall.cpp

926

Does the string of the argument have to be the dummy argument name as specified in the spec? If so, in my draft of Fortran 2018 this is called r instead of scalar.

I don't think the string must be totally same as that in the standard. Usually it's better to keep the same since the argument name in the standard means something. scalar has better meaning than r, so I use it.

Also, why passing the argument asAddr, could it be passed asValue instead? I imagine that would require converting the value into some specific integer type before passing it to the runtime function. Do we really expect a user to pass an integer so large that forces us to cast the address to the proper integer type.

This intrinsic is not performance-sensitive. It is recommended to use the current approach in https://reviews.llvm.org/D130183#3667603.

[rogfer01]

flang/lib/Lower/IntrinsicCall.cpp

926

Thanks for the clarifications!

flang/include/flang/Optimizer/Builder/Runtime/Numeric.h

 /// Generate call to RRSpacing intrinsic runtime routine.
 mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value x);
 
 /// Generate call to Scale intrinsic runtime routine.
 mlir::Value genScale(fir::FirOpBuilder &builder, mlir::Location loc,
                      mlir::Value x, mlir::Value i);
 
+/// Generate call to Selected_int_kind intrinsic runtime routine.
+mlir::Value genSelectedIntKind(fir::FirOpBuilder &builder, mlir::Location loc,
+                               mlir::Value x);
+
 /// Generate call to Selected_real_kind intrinsic runtime routine.
 mlir::Value genSelectedRealKind(fir::FirOpBuilder &builder, mlir::Location loc,
                                 mlir::Value precision, mlir::Value range,
                                 mlir::Value radix);
 
 /// Generate call to Set_exponent intrinsic runtime routine.
 mlir::Value genSetExponent(fir::FirOpBuilder &builder, mlir::Location loc,
                            mlir::Value x, mlir::Value i);
 
 /// Generate call to Spacing intrinsic runtime routine.
 mlir::Value genSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value x);
 
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_NUMERIC_H

flang/include/flang/Runtime/numeric.h

 CppTypeFor<TypeCategory::Real, 10> RTNAME(Scale10)(
     CppTypeFor<TypeCategory::Real, 10>, std::int64_t);
 #endif
 #if LDBL_MANT_DIG == 113 || HAS_FLOAT128
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16>, std::int64_t);
 #endif
 
+// SELECTED_INT_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedIntKind)(
+    const char *, int, void *, int);
+
 // SELECTED_REAL_KIND
 CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind)(
     const char *, int, void *, int, void *, int, void *, int);
 
 // SPACING
 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
     CppTypeFor<TypeCategory::Real, 4>);
 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
                            llvm::ArrayRef<mlir::Value> args);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSetExponent(mlir::Type resultType,
                              llvm::ArrayRef<mlir::Value> args);
   template <typename Shift>
   mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSpacing(mlir::Type resultType,
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/true},
     {"scan",
      &I::genScan,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
+    {"selected_int_kind",
+     &I::genSelectedIntKind,
+     {{{"scalar", asAddr}}},
+     /*isElemental=*/false},
     {"selected_real_kind",
      &I::genSelectedRealKind,
      {{{"precision", asAddr, handleDynamicOptional},
        {"range", asAddr, handleDynamicOptional},
        {"radix", asAddr, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"set_exponent", &I::genSetExponent},
     {"shifta", &I::genShift<mlir::arith::ShRSIOp>},
fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
                                   kind);
 
   // Handle cleanup of allocatable result descriptor and return
   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
 }
 
 // SELECTED_INT_KIND
 mlir::Value
+IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType,
+                                     llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 1);
+
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0])));
+}
+
+// SELECTED_REAL_KIND
+mlir::Value
 IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 3);
 
   // Handle optional precision(P) argument
   mlir::Value precision =
       isStaticallyAbsent(args[0])
           ? builder.create<fir::AbsentOp>(

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

else
     fir::emitFatalError(loc, "unsupported REAL kind in SCALE");
 
   auto funcTy = func.getFunctionType();
   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+/// Generate call to Selected_int_kind intrinsic runtime routine.
+mlir::Value fir::runtime::genSelectedIntKind(fir::FirOpBuilder &builder,
+                                             mlir::Location loc,
+                                             mlir::Value x) {
+  mlir::func::FuncOp func =
+      fir::runtime::getRuntimeFunc<mkRTKey(SelectedIntKind)>(loc, builder);
+  auto fTy = func.getFunctionType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
+  if (!fir::isa_ref_type(x.getType()))
+    fir::emitFatalError(loc, "argument address for runtime not found");
+  mlir::Type eleTy = fir::unwrapRefType(x.getType());
+  mlir::Value xKind = builder.createIntegerConstant(
+      loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);
+  auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
+                                            sourceLine, x, xKind);
+
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
+
 /// Generate call to Selected_real_kind intrinsic runtime routine.
 mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,
                                               mlir::Location loc,
                                               mlir::Value precision,
                                               mlir::Value range,
                                               mlir::Value radix) {
   mlir::func::FuncOp func =
       fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind)>(loc, builder);
   auto fTy = func.getFunctionType();
   auto getArgKinds = [&](mlir::Value arg, int argKindIndex) -> mlir::Value {

flang/runtime/numeric.cpp

template <typename T> inline T Scale(T x, std::int64_t p) {
   auto ip{static_cast<int>(p)};
   if (ip != p) {
     ip = p < 0 ? std::numeric_limits<int>::min()
                : std::numeric_limits<int>::max();
   }
   return std::ldexp(x, p); // x*2**p
 }
 
+// SELECTED_INT_KIND (16.9.169)
+template <typename T>
+inline CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(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;
+#ifdef __SIZEOF_INT128__
+  } else if (x <= 38) {
+    return 16;
+#endif
+  }
+  return -1;
+}
+
 // SELECTED_REAL_KIND (16.9.170)
 template <typename P, typename R, typename D>
 inline CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(P p, R r, D d) {
   if (d != 2) {
     return -5;
   }
 
   int error{0};

 }
 #elif LDBL_MANT_DIG == 113
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16> x, std::int64_t p) {
   return Scale(x, p);
 }
 #endif
 
+// SELECTED_INT_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedIntKind)(
+    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 SelectedIntKind(r);
+}
+
 // SELECTED_REAL_KIND
 CppTypeFor<TypeCategory::Integer, 4> RTNAME(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>>(
           source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);

flang/test/Lower/Intrinsics/selected_int_kind.f90

+! REQUIRES: shell
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPselected_int_kind_test1(
+! CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<i8> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i8 {bindc_name = "res", uniq_name = "_QFselected_int_kind_test1Eres"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i8>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedIntKind(%{{.*}}, %{{.*}}, %[[VAL_6]], %[[VAL_4]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i8
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref<i8>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_int_kind_test1(a)
+  integer(1) :: a, res
+  res = selected_int_kind(a)
+end
+
+! CHECK-LABEL: func.func @_QPselected_int_kind_test2(
+! CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<i16> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i16 {bindc_name = "res", uniq_name = "_QFselected_int_kind_test2Eres"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i16>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedIntKind(%{{.*}}, %{{.*}}, %[[VAL_6]], %[[VAL_4]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i16
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref<i16>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_int_kind_test2(a)
+  integer(2) :: a, res
+  res = selected_int_kind(a)
+end
+
+! CHECK-LABEL: func.func @_QPselected_int_kind_test4(
+! CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_int_kind_test4Eres"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedIntKind(%{{.*}}, %{{.*}}, %[[VAL_6]], %[[VAL_4]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         fir.store %[[VAL_7]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_int_kind_test4(a)
+  integer(4) :: a, res
+  res = selected_int_kind(a)
+end
+
+! CHECK-LABEL: func.func @_QPselected_int_kind_test8(
+! CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i64 {bindc_name = "res", uniq_name = "_QFselected_int_kind_test8Eres"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 8 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedIntKind(%{{.*}}, %{{.*}}, %[[VAL_6]], %[[VAL_4]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i64
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref<i64>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_int_kind_test8(a)
+  integer(8) :: a, res
+  res = selected_int_kind(a)
+end
+
+! CHECK-LABEL: func.func @_QPselected_int_kind_test16(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i128> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i128 {bindc_name = "res", uniq_name = "_QFselected_int_kind_test16Eres"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 16 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i128>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedIntKind(%{{.*}}, %{{.*}}, %[[VAL_6]], %[[VAL_4]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i128
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref<i128>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_int_kind_test16(a)
+  integer(16) :: a, res
+  res = selected_int_kind(a)
+end

flang/unittests/Runtime/Numeric.cpp

TEST(Numeric, Scale) {
   EXPECT_TRUE(
       std::isnan(RTNAME(Scale8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
 TEST(Numeric, SetExponent) {
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{0}, 0), 0);
   EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{0}, 666), 0);
   EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{3.0}, 0), 0.75);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 0), 0.5);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 1), 1.0);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, -1), 0.25);
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent4)(std::numeric_limits<Real<4>>::infinity(), 1)));
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
+TEST(Numeric, SelectedIntKind) {
+  std::int8_t r0 = 1;
+  std::int16_t r1 = 3;
+  std::int32_t r2 = 8;
+  std::int64_t r3 = 10;
+  std::int32_t r4 = -10;
+  std::int32_t r5 = 100;
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r0, 1), 1);
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r1, 2), 2);
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r2, 4), 4);
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r3, 8), 8);
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r4, 4), 1);
+  EXPECT_EQ(RTNAME(SelectedIntKind)(__FILE__, __LINE__, &r5, 4), -1);
+}
+
 TEST(Numeric, SelectedRealKind) {
   std::int8_t p_s = 1;
   std::int16_t p[11] = {-10, 1, 1, 4, 50, 1, 1, 4, 1, 1, 50};
   std::int32_t r[11] = {-1, 1, 1, 1, 2, 1, 20, 20, 100, 5000, 5000};
   std::int64_t d[11] = {2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2};
   EXPECT_EQ(RTNAME(SelectedRealKind)(
                 __FILE__, __LINE__, &p[0], 2, &r[0], 4, &d[0], 8),
       2);