[flang] Lower misc intrinsics

[clementval]

Summary

This patch adds lowering for couple of intrinsics:

• btest
• ceiling
• nearest
• scale

This patch is part of the upstreaming effort from fir-dev branch.

[jeanPerier]

Looks good

flang/lib/Lower/IntrinsicCall.cpp

fir::ExtendedValue genAdjustRtCall(mlir::Type,
                                      llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAllocated(mlir::Type,
                                   llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAssociated(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   template <mlir::arith::CmpIPredicate pred>
   fir::ExtendedValue genCharacterCompare(mlir::Type,
                                          llvm::ArrayRef<fir::ExtendedValue>);
   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
struct IntrinsicLibrary {
   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSetExponent(mlir::Type resultType,
                              llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genTransfer(mlir::Type,
static constexpr IntrinsicHandler handlers[]{
     {"any",
      &I::genAny,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
     {"associated",
      &I::genAssociated,
      {{{"pointer", asInquired}, {"target", asInquired}}},
      /*isElemental=*/false},
+    {"btest", &I::genBtest},
+    {"ceiling", &I::genCeiling},
     {"char", &I::genChar},
     {"count",
      &I::genCount,
      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
      /*isElemental=*/false},
     {"cpu_time",
      &I::genCpuTime,
      {{{"time", asAddr}}},
static constexpr IntrinsicHandler handlers[]{
     {"minval",
      &I::genMinval,
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"mod", &I::genMod},
     {"modulo", &I::genModulo},
+    {"nearest", &I::genNearest},
     {"nint", &I::genNint},
     {"not", &I::genNot},
     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
     {"pack",
      &I::genPack,
      {{{"array", asBox},
        {"mask", asBox},
        {"vector", asBox, handleDynamicOptional}}},
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/false},
     {"reshape",
      &I::genReshape,
      {{{"source", asBox},
        {"shape", asBox},
        {"pad", asBox, handleDynamicOptional},
        {"order", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"scale",
+     &I::genScale,
+     {{{"x", asValue}, {"i", asValue}}},
+     /*isElemental=*/true},
     {"scan",
      &I::genScan,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
     {"set_exponent", &I::genSetExponent},

 }
 
 // TODO : Fill-up this table with more intrinsic.
 // Note: These are also defined as operations in LLVM dialect. See if this
 // can be use and has advantages.
 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},
     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>},
     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>},
     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>},
     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>},
     {"pow", "llvm.pow.f32", genF32F32F32FuncType},
targetBox = builder.create<mlir::arith::SelectOp>(loc, isPresent, targetBox,
                                                       absentBox);
   }
   mlir::Value pointerBoxRef =
       fir::factory::getMutableIRBox(builder, loc, *pointer);
   auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
   return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
 }
 
+// BTEST
+mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> 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<mlir::arith::ShRUIOp>(loc, args[0], pos);
+  mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
+  auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
+  return builder.createConvert(loc, resultType, res);
+}
+
+// CEILING
+mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
+                                         llvm::ArrayRef<mlir::Value> 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,
                           llvm::ArrayRef<fir::ExtendedValue> args) {
   // Optional KIND argument.
   assert(args.size() >= 1);
   const mlir::Value *arg = args[0].getUnboxed();
   // expect argument to be a scalar integer
auto argSignDifferent =
       builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
   auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
                                                       argSignDifferent);
   auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
   return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
                                                remainder);
 }
 
+// NEAREST
+mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
+                                         llvm::ArrayRef<mlir::Value> 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<mlir::Value> args) {
   assert(args.size() >= 1);
   // Skip optional kind argument to search the runtime; it is already reflected
   // in result type.
   return genRuntimeCall("nint", resultType, {args[0]});
 }
IntrinsicLibrary::genReshape(mlir::Type resultType,
 
   fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
                            order);
 
   return readAndAddCleanUp(resultMutableBox, resultType,
                            "unexpected result for RESHAPE");
 }
 
+// SCALE
+mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> 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,
                           llvm::ArrayRef<fir::ExtendedValue> args) {
 
   assert(args.size() == 4);
 
   if (isAbsent(args[3])) {

flang/test/Lower/Intrinsics/btest.f90

+! 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<i32>
+    ! CHECK-DAG: %[[j:[0-9]+]] = fir.load %arg1 : !fir.ref<i32>
+    ! 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<!fir.logical<4>>
+    ! CHECK: %[[VAL_9:.*]] = fir.load %[[result]] : !fir.ref<!fir.logical<4>>
+    ! CHECK: return %[[VAL_9]] : !fir.logical<4>
+    btest_test = btest(i, j)
+  end
+  
 No newline at end of file

flang/test/Lower/Intrinsics/ceiling.f90

+! 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

flang/test/Lower/Intrinsics/nearest.f90

+! 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<f32>
+  ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f32>
+  ! 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<f32>
+  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<f64>
+  ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f64>
+  ! 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<f64>
+  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<f80>
+  ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f80>
+  ! 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<f80>
+  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<f128>
+  ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f128>
+  ! 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<f128>
+  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<f128>
+    real :: s
+  ! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f32>
+  ! 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<f128>
+  end subroutine nearest_test5

flang/test/Lower/Intrinsics/scale.f90

+! 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<f32>
+    integer :: i
+  ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref<i32>
+    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<f32>
+  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<f64>
+    integer :: i
+  ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref<i32>
+    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<f64>
+  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<f80>
+    integer :: i
+  ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref<i32>
+    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<f80>
+  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<f128>
+    integer :: i
+  ! CHECK: %[[i0:.*]] = fir.load %arg1 : !fir.ref<i32>
+    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<f128>
+  end subroutine scale_test4