[flang] Support intrinsic selected_int_kind for variables

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.

Reviewed By: Jean Perier

Differential Revision: https://reviews.llvm.org/D129959
This commit is contained in:
Peixin Qiao 2022-07-26 00:33:27 +08:00
parent 640c0ad0d5
commit f532c07211
7 changed files with 174 additions and 0 deletions

View File

@ -38,6 +38,10 @@ mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
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,

View File

@ -355,6 +355,10 @@ 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);

View File

@ -545,6 +545,7 @@ struct IntrinsicLibrary {
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);
@ -920,6 +921,10 @@ static constexpr IntrinsicHandler handlers[]{
{"back", asValue, handleDynamicOptional},
{"kind", asValue}}},
/*isElemental=*/true},
{"selected_int_kind",
&I::genSelectedIntKind,
{{{"scalar", asAddr}}},
/*isElemental=*/false},
{"selected_real_kind",
&I::genSelectedRealKind,
{{{"precision", asAddr, handleDynamicOptional},
@ -3768,6 +3773,17 @@ IntrinsicLibrary::genScan(mlir::Type resultType,
// 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);

View File

@ -360,6 +360,27 @@ mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
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,

View File

@ -142,6 +142,25 @@ template <typename T> inline T Scale(T x, std::int64_t p) {
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) {
@ -794,6 +813,20 @@ CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
}
#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,

View File

@ -0,0 +1,81 @@
! 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

View File

@ -130,6 +130,21 @@ TEST(Numeric, SetExponent) {
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};