diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -442,6 +442,8 @@ fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); + mlir::Value genBtest(mlir::Type, llvm::ArrayRef); + mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef); template @@ -481,6 +483,7 @@ fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef); mlir::Value genMod(mlir::Type, llvm::ArrayRef); mlir::Value genModulo(mlir::Type, llvm::ArrayRef); + mlir::Value genNearest(mlir::Type, llvm::ArrayRef); mlir::Value genNint(mlir::Type, llvm::ArrayRef); mlir::Value genNot(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef); @@ -491,6 +494,7 @@ void genRandomNumber(llvm::ArrayRef); void genRandomSeed(llvm::ArrayRef); fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef); + mlir::Value genScale(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef); mlir::Value genSetExponent(mlir::Type resultType, llvm::ArrayRef args); @@ -623,6 +627,8 @@ &I::genAssociated, {{{"pointer", asInquired}, {"target", asInquired}}}, /*isElemental=*/false}, + {"btest", &I::genBtest}, + {"ceiling", &I::genCeiling}, {"char", &I::genChar}, {"count", &I::genCount, @@ -718,6 +724,7 @@ /*isElemental=*/false}, {"mod", &I::genMod}, {"modulo", &I::genModulo}, + {"nearest", &I::genNearest}, {"nint", &I::genNint}, {"not", &I::genNot}, {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false}, @@ -756,6 +763,10 @@ {"pad", asBox, handleDynamicOptional}, {"order", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"scale", + &I::genScale, + {{{"x", asValue}, {"i", asValue}}}, + /*isElemental=*/true}, {"scan", &I::genScan, {{{"string", asAddr}, @@ -896,6 +907,9 @@ static constexpr RuntimeFunction llvmIntrinsics[] = { {"abs", "llvm.fabs.f32", genF32F32FuncType}, {"abs", "llvm.fabs.f64", genF64F64FuncType}, + // ceil is used for CEILING but is different, it returns a real. + {"ceil", "llvm.ceil.f32", genF32F32FuncType}, + {"ceil", "llvm.ceil.f64", genF64F64FuncType}, // llvm.floor is used for FLOOR, but returns real. {"floor", "llvm.floor.f32", genF32F32FuncType}, {"floor", "llvm.floor.f64", genF64F64FuncType}, @@ -1769,6 +1783,35 @@ return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox); } +// BTEST +mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType, + llvm::ArrayRef args) { + // A conformant BTEST(I,POS) call satisfies: + // POS >= 0 + // POS < BIT_SIZE(I) + // Return: (I >> POS) & 1 + assert(args.size() == 2); + mlir::Type argType = args[0].getType(); + mlir::Value pos = builder.createConvert(loc, argType, args[1]); + auto shift = builder.create(loc, args[0], pos); + mlir::Value one = builder.createIntegerConstant(loc, argType, 1); + auto res = builder.create(loc, shift, one); + return builder.createConvert(loc, resultType, res); +} + +// CEILING +mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, + llvm::ArrayRef args) { + // Optional KIND argument. + assert(args.size() >= 1); + mlir::Value arg = args[0]; + // Use ceil that is not an actual Fortran intrinsic but that is + // an llvm intrinsic that does the same, but return a floating + // point. + mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg}); + return builder.createConvert(loc, resultType, ceil); +} + // CHAR fir::ExtendedValue IntrinsicLibrary::genChar(mlir::Type type, @@ -2502,6 +2545,18 @@ remainder); } +// NEAREST +mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + mlir::Value realX = fir::getBase(args[0]); + mlir::Value realS = fir::getBase(args[1]); + + return builder.createConvert( + loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS)); +} + // NINT mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType, llvm::ArrayRef args) { @@ -2657,6 +2712,18 @@ "unexpected result for RESHAPE"); } +// SCALE +mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + mlir::Value realX = fir::getBase(args[0]); + mlir::Value intI = fir::getBase(args[1]); + + return builder.createConvert( + loc, resultType, fir::runtime::genScale(builder, loc, realX, intI)); +} + // SCAN fir::ExtendedValue IntrinsicLibrary::genScan(mlir::Type resultType, diff --git a/flang/test/Lower/Intrinsics/btest.f90 b/flang/test/Lower/Intrinsics/btest.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/btest.f90 @@ -0,0 +1,18 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: btest_test +function btest_test(i, j) + logical btest_test + ! CHECK-DAG: %[[result:[0-9]+]] = fir.alloca !fir.logical<4> {bindc_name = "btest_test" + ! CHECK-DAG: %[[i:[0-9]+]] = fir.load %arg0 : !fir.ref + ! CHECK-DAG: %[[j:[0-9]+]] = fir.load %arg1 : !fir.ref + ! CHECK-DAG: %[[VAL_5:.*]] = arith.shrui %[[i]], %[[j]] : i32 + ! CHECK-DAG: %[[VAL_6:.*]] = arith.constant 1 : i32 + ! CHECK: %[[VAL_7:.*]] = arith.andi %[[VAL_5]], %[[VAL_6]] : i32 + ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> !fir.logical<4> + ! CHECK: fir.store %[[VAL_8]] to %[[result]] : !fir.ref> + ! CHECK: %[[VAL_9:.*]] = fir.load %[[result]] : !fir.ref> + ! CHECK: return %[[VAL_9]] : !fir.logical<4> + btest_test = btest(i, j) + end + \ No newline at end of file diff --git a/flang/test/Lower/Intrinsics/ceiling.f90 b/flang/test/Lower/Intrinsics/ceiling.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/ceiling.f90 @@ -0,0 +1,20 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: ceiling_test1 +subroutine ceiling_test1(i, a) + integer :: i + real :: a + i = ceiling(a) + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i32 + end subroutine + ! CHECK-LABEL: ceiling_test2 + subroutine ceiling_test2(i, a) + integer(8) :: i + real :: a + i = ceiling(a, 8) + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i64 + end subroutine + + \ No newline at end of file diff --git a/flang/test/Lower/Intrinsics/nearest.f90 b/flang/test/Lower/Intrinsics/nearest.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/nearest.f90 @@ -0,0 +1,72 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: nearest_test1 +subroutine nearest_test1(x, s) + real :: x, s, res + ! CHECK: %[[res:.*]] = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFnearest_test1Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref + ! CHECK: %[[zero:.*]] = arith.constant 0.000000e+00 : f32 + ! CHECK: %[[cmp:.*]] = arith.cmpf ogt, %[[s]], %[[zero]] : f32 + ! CHECK: %[[pos:.*]] = arith.select %[[cmp]], %true, %false : i1 + res = nearest(x, s) + ! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest4(%[[x]], %[[pos]]) : (f32, i1) -> f32 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine nearest_test1 + + ! CHECK-LABEL: nearest_test2 + subroutine nearest_test2(x, s) + real(kind=8) :: x, s, res + ! CHECK: %[[res:.*]] = fir.alloca f64 {bindc_name = "res", uniq_name = "_QFnearest_test2Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref + ! CHECK: %[[zero:.*]] = arith.constant 0.000000e+00 : f64 + ! CHECK: %[[cmp:.*]] = arith.cmpf ogt, %[[s]], %[[zero]] : f64 + ! CHECK: %[[pos:.*]] = arith.select %[[cmp]], %true, %false : i1 + res = nearest(x, s) + ! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest8(%[[x]], %[[pos]]) : (f64, i1) -> f64 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine nearest_test2 + + ! CHECK-LABEL: nearest_test3 + subroutine nearest_test3(x, s) + real(kind=10) :: x, s, res + ! CHECK: %[[res:.*]] = fir.alloca f80 {bindc_name = "res", uniq_name = "_QFnearest_test3Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref + ! CHECK: %[[zero:.*]] = arith.constant 0.000000e+00 : f80 + ! CHECK: %[[cmp:.*]] = arith.cmpf ogt, %[[s]], %[[zero]] : f80 + ! CHECK: %[[pos:.*]] = arith.select %[[cmp]], %true, %false : i1 + res = nearest(x, s) + ! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest10(%[[x]], %[[pos]]) : (f80, i1) -> f80 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine nearest_test3 + + ! CHECK-LABEL: nearest_test4 + subroutine nearest_test4(x, s) + real(kind=16) :: x, s, res + ! CHECK: %[[res:.*]] = fir.alloca f128 {bindc_name = "res", uniq_name = "_QFnearest_test4Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref + ! CHECK: %[[zero:.*]] = arith.constant 0.000000e+00 : f128 + ! CHECK: %[[cmp:.*]] = arith.cmpf ogt, %[[s]], %[[zero]] : f128 + ! CHECK: %[[pos:.*]] = arith.select %[[cmp]], %true, %false : i1 + res = nearest(x, s) + ! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest16(%[[x]], %[[pos]]) : (f128, i1) -> f128 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine nearest_test4 + + ! CHECK-LABEL: nearest_test5 + subroutine nearest_test5(x, s) + real(kind=16) :: x, res + ! CHECK: %[[res:.*]] = fir.alloca f128 {bindc_name = "res", uniq_name = "_QFnearest_test5Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + real :: s + ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref + ! CHECK: %[[zero:.*]] = arith.constant 0.000000e+00 : f32 + ! CHECK: %[[cmp:.*]] = arith.cmpf ogt, %[[s]], %[[zero]] : f32 + ! CHECK: %[[pos:.*]] = arith.select %[[cmp]], %true, %false : i1 + res = nearest(x, s) + ! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest16(%[[x]], %[[pos]]) : (f128, i1) -> f128 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine nearest_test5 diff --git a/flang/test/Lower/Intrinsics/scale.f90 b/flang/test/Lower/Intrinsics/scale.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/scale.f90 @@ -0,0 +1,53 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: scale_test1 +subroutine scale_test1(x, i) + real :: x, res + ! CHECK: %[[res:.*]] = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFscale_test1Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + integer :: i + ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref + res = scale(x, i) + ! CHECK: %[[i1:.*]] = fir.convert %[[i0]] : (i32) -> i64 + ! CHECK: %[[tmp:.*]] = fir.call @_FortranAScale4(%[[x]], %[[i1]]) : (f32, i64) -> f32 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine scale_test1 + + ! CHECK-LABEL: scale_test2 + subroutine scale_test2(x, i) + real(kind=8) :: x, res + ! CHECK: %[[res:.*]] = fir.alloca f64 {bindc_name = "res", uniq_name = "_QFscale_test2Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + integer :: i + ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref + res = scale(x, i) + ! CHECK: %[[i1:.*]] = fir.convert %[[i0]] : (i32) -> i64 + ! CHECK: %[[tmp:.*]] = fir.call @_FortranAScale8(%[[x]], %[[i1]]) : (f64, i64) -> f64 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine scale_test2 + + ! CHECK-LABEL: scale_test3 + subroutine scale_test3(x, i) + real(kind=10) :: x, res + ! CHECK: %[[res:.*]] = fir.alloca f80 {bindc_name = "res", uniq_name = "_QFscale_test3Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + integer :: i + ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref + res = scale(x, i) + ! CHECK: %[[i1:.*]] = fir.convert %[[i0]] : (i32) -> i64 + ! CHECK: %[[tmp:.*]] = fir.call @_FortranAScale10(%[[x]], %[[i1]]) : (f80, i64) -> f80 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine scale_test3 + + ! CHECK-LABEL: scale_test4 + subroutine scale_test4(x, i) + real(kind=16) :: x, res + ! CHECK: %[[res:.*]] = fir.alloca f128 {bindc_name = "res", uniq_name = "_QFscale_test4Eres"} + ! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref + integer :: i + ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref + res = scale(x, i) + ! CHECK: %[[i1:.*]] = fir.convert %[[i0]] : (i32) -> i64 + ! CHECK: %[[tmp:.*]] = fir.call @_FortranAScale16(%[[x]], %[[i1]]) : (f128, i64) -> f128 + ! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref + end subroutine scale_test4