[flang] Lower some numeric intrinsics

[clementval]

Summary

This patch adds lowering for the following numeric intrinsics:

• aint
• anint
• cmplx
• conjg
• dble
• dprod
• sign

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

flang/lib/Lower/ConvertExpr.cpp

return addr.match(
       [](const fir::CharBoxValue &box) -> fir::ExtendedValue { return box; },
       [&](const fir::UnboxedValue &v) -> fir::ExtendedValue {
         if (fir::unwrapRefType(fir::getBase(v).getType())
                 .isa<fir::RecordType>())
           return v;
         return builder.create<fir::LoadOp>(loc, fir::getBase(v));
       },
       [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
-        TODO(loc, "genLoad for MutableBoxValue");
+        return genLoad(builder, loc,
+                       fir::factory::genMutableBoxRead(builder, loc, box));
       },
       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
-        TODO(loc, "genLoad for BoxValue");
+        if (box.isUnlimitedPolymorphic())
+          fir::emitFatalError(
+              loc,
+              "lowering attempting to load an unlimited polymorphic entity");
+        return genLoad(builder, loc,
+                       fir::factory::readBoxValue(builder, loc, box));
       },
       [&](const auto &) -> fir::ExtendedValue {
         fir::emitFatalError(
             loc, "attempting to load whole array or procedure address");
       });
 }
 
 /// Create an optional dummy argument value from entity \p exv that may be

flang/lib/Lower/IntrinsicCall.cpp

 
 /// Test if an ExtendedValue is absent.
 static bool isAbsent(const fir::ExtendedValue &exv) {
   return !fir::getBase(exv);
 }
 static bool isAbsent(llvm::ArrayRef<fir::ExtendedValue> args, size_t argIndex) {
   return args.size() <= argIndex || isAbsent(args[argIndex]);
 }
+static bool isAbsent(llvm::ArrayRef<mlir::Value> args, size_t argIndex) {
+  return args.size() <= argIndex || !args[argIndex];
+}
 
 /// Test if an ExtendedValue is present.
 static bool isPresent(const fir::ExtendedValue &exv) { return !isAbsent(exv); }
 
 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
 /// take a DIM argument.
 template <typename FD>
 static fir::ExtendedValue
struct IntrinsicLibrary {
   /// if the argument is an integer, into llvm intrinsics if the argument is
   /// real and to the `hypot` math routine if the argument is of complex type.
   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
                                 mlir::Value, mlir::Value)>
   fir::ExtendedValue genAdjustRtCall(mlir::Type,
                                      llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAllocated(mlir::Type,
                                   llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   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
       genCommandArgumentCount(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>);
+  mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genDotProduct(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <Extremum, ExtremumBehavior>
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genFraction(mlir::Type resultType,
                           mlir::ArrayRef<mlir::Value> args);
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 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);
+  mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
   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,
                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genTranspose(mlir::Type,
                                   llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  /// Implement all conversion functions like DBLE, the first argument is
+  /// the value to convert. There may be an additional KIND arguments that
+  /// is ignored because this is already reflected in the result type.
+  mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
 
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.
   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
   using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum);
   using SubroutineGenerator = decltype(&IntrinsicLibrary::genRandomInit);
   using Generator =
       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
static constexpr IntrinsicHandler handlers[]{
      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
      {{{"string", asAddr}}},
      /*isElemental=*/true},
     {"adjustr",
      &I::genAdjustRtCall<fir::runtime::genAdjustR>,
      {{{"string", asAddr}}},
      /*isElemental=*/true},
     {"aimag", &I::genAimag},
+    {"aint", &I::genAint},
     {"all",
      &I::genAll,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
     {"allocated",
      &I::genAllocated,
      {{{"array", asInquired}, {"scalar", asInquired}}},
      /*isElemental=*/false},
+    {"anint", &I::genAnint},
     {"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},
+    {"cmplx",
+     &I::genCmplx,
+     {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
     {"command_argument_count", &I::genCommandArgumentCount},
+    {"conjg", &I::genConjg},
     {"count",
      &I::genCount,
      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
      /*isElemental=*/false},
     {"cpu_time",
      &I::genCpuTime,
      {{{"time", asAddr}}},
      /*isElemental=*/false},
     {"cshift",
      &I::genCshift,
      {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
     {"date_and_time",
      &I::genDateAndTime,
      {{{"date", asAddr, handleDynamicOptional},
        {"time", asAddr, handleDynamicOptional},
        {"zone", asAddr, handleDynamicOptional},
        {"values", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"dble", &I::genConversion},
     {"dim", &I::genDim},
     {"dot_product",
      &I::genDotProduct,
      {{{"vector_a", asBox}, {"vector_b", asBox}}},
      /*isElemental=*/false},
+    {"dprod", &I::genDprod},
     {"eoshift",
      &I::genEoshift,
      {{{"array", asBox},
        {"shift", asAddr},
        {"boundary", asBox, handleDynamicOptional},
        {"dim", asValue}}},
      /*isElemental=*/false},
     {"exit",
static constexpr IntrinsicHandler handlers[]{
     {"scan",
      &I::genScan,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
     {"set_exponent", &I::genSetExponent},
+    {"sign", &I::genSign},
     {"size",
      &I::genSize,
      {{{"array", asBox},
        {"dim", asAddr, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/false},
     {"spread",
      &I::genSpread,
static mlir::FunctionType genF32F32F32FuncType(mlir::MLIRContext *context) {
   return mlir::FunctionType::get(context, {t, t}, {t});
 }
 
 static mlir::FunctionType genF64F64F64FuncType(mlir::MLIRContext *context) {
   auto t = mlir::FloatType::getF64(context);
   return mlir::FunctionType::get(context, {t, t}, {t});
 }
 
+static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) {
+  auto t = mlir::FloatType::getF80(context);
+  return mlir::FunctionType::get(context, {t, t}, {t});
+}
+
+static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) {
+  auto t = mlir::FloatType::getF128(context);
+  return mlir::FunctionType::get(context, {t, t}, {t});
+}
+
 template <int Bits>
 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
   auto t = mlir::FloatType::getF64(context);
   auto r = mlir::IntegerType::get(context, Bits);
   return mlir::FunctionType::get(context, {t}, {r});
 }
 
 template <int Bits>
 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
   auto t = mlir::FloatType::getF32(context);
   auto r = mlir::IntegerType::get(context, Bits);
   return mlir::FunctionType::get(context, {t}, {r});
 }
 
 // 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},
+    {"aint", "llvm.trunc.f32", genF32F32FuncType},
+    {"aint", "llvm.trunc.f64", genF64F64FuncType},
+    {"anint", "llvm.round.f32", genF32F32FuncType},
+    {"anint", "llvm.round.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},
     {"pow", "llvm.pow.f64", genF64F64F64FuncType},
+    {"sign", "llvm.copysign.f32", genF32F32F32FuncType},
+    {"sign", "llvm.copysign.f64", genF64F64F64FuncType},
+    {"sign", "llvm.copysign.f80", genF80F80F80FuncType},
+    {"sign", "llvm.copysign.f128", genF128F128F128FuncType},
 };
 
 // This helper class computes a "distance" between two function types.
 // The distance measures how many narrowing conversions of actual arguments
 // and result of "from" must be made in order to use "to" instead of "from".
 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
 // if no implementation of ACOS(REAL(10)) is available, it is better to use

 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
                                              mlir::Type resultType,
                                              llvm::ArrayRef<mlir::Value> args) {
   mlir::FunctionType soughtFuncType =
       getFunctionType(resultType, args, builder);
   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
 }
 
+mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
+                                            llvm::ArrayRef<mlir::Value> args) {
+  // There can be an optional kind in second argument.
+  assert(args.size() >= 1);
+  return builder.convertWithSemantics(loc, resultType, args[0]);
+}
+
 // ABS
 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
                                      llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
   mlir::Value arg = args[0];
   mlir::Type type = arg.getType();
   if (fir::isa_real(type)) {
     // Runtime call to fp abs. An alternative would be to use mlir

 // AIMAG
 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
   return fir::factory::Complex{builder, loc}.extractComplexPart(
       args[0], true /* isImagPart */);
 }
 
+// AINT
+mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() >= 1 && args.size() <= 2);
+  // Skip optional kind argument to search the runtime; it is already reflected
+  // in result type.
+  return genRuntimeCall("aint", resultType, {args[0]});
+}
+
 // ALL
 fir::ExtendedValue
 IntrinsicLibrary::genAll(mlir::Type resultType,
                          llvm::ArrayRef<fir::ExtendedValue> args) {
 
   assert(args.size() == 2);
   // Handle required mask argument
   mlir::Value mask = builder.createBox(loc, args[0]);
return args[0].match(
         return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
       },
       [&](const auto &) -> fir::ExtendedValue {
         fir::emitFatalError(loc,
                             "allocated arg not lowered to MutableBoxValue");
       });
 }
 
+// ANINT
+mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() >= 1 && args.size() <= 2);
+  // Skip optional kind argument to search the runtime; it is already reflected
+  // in result type.
+  return genRuntimeCall("anint", resultType, {args[0]});
+}
+
 // ANY
 fir::ExtendedValue
 IntrinsicLibrary::genAny(mlir::Type resultType,
                          llvm::ArrayRef<fir::ExtendedValue> args) {
 
   assert(args.size() == 2);
   // Handle required mask argument
   mlir::Value mask = builder.createBox(loc, args[0]);
IntrinsicLibrary::genChar(mlir::Type type,
   fir::factory::CharacterExprHelper helper{builder, loc};
   fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
   mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
   mlir::Value len =
       builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
   return fir::CharBoxValue{cast, len};
 }
 
+// CMPLX
+mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() >= 1);
+  fir::factory::Complex complexHelper(builder, loc);
+  mlir::Type partType = complexHelper.getComplexPartType(resultType);
+  mlir::Value real = builder.createConvert(loc, partType, args[0]);
+  mlir::Value imag = isAbsent(args, 1)
+                         ? builder.createRealZeroConstant(loc, partType)
+                         : builder.createConvert(loc, partType, args[1]);
+  return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
+                                                           imag);
+}
+
 // COMMAND_ARGUMENT_COUNT
 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
     mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 0);
   assert(resultType == builder.getDefaultIntegerType() &&
          "result type is not default integer kind type");
   return builder.createConvert(
       loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
   ;
 }
 
+// CONJG
+mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 1);
+  if (resultType != args[0].getType())
+    llvm_unreachable("argument type mismatch");
+
+  mlir::Value cplx = args[0];
+  auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
+      cplx, /*isImagPart=*/true);
+  auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
+  return fir::factory::Complex{builder, loc}.insertComplexPart(
+      cplx, negImag, /*isImagPart=*/true);
+}
+
 // COUNT
 fir::ExtendedValue
 IntrinsicLibrary::genCount(mlir::Type resultType,
                            llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 3);
 
   // Handle mask argument
   fir::BoxValue mask = builder.createBox(loc, args[0]);
mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
   mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
   auto cmp = builder.create<mlir::arith::CmpFOp>(
       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
   return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
 }
 
+// DPROD
+mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
+                                       llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 2);
+  assert(fir::isa_real(resultType) &&
+         "Result must be double precision in DPROD");
+  mlir::Value a = builder.createConvert(loc, resultType, args[0]);
+  mlir::Value b = builder.createConvert(loc, resultType, args[1]);
+  return builder.create<mlir::arith::MulFOp>(loc, a, b);
+}
+
 // DOT_PRODUCT
 fir::ExtendedValue
 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
                                 llvm::ArrayRef<fir::ExtendedValue> args) {
   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
                     stmtCtx, args);
 }
 
mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
   assert(args.size() == 2);
 
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
                                    fir::getBase(args[1])));
 }
 
-// SPREAD
-fir::ExtendedValue
-IntrinsicLibrary::genSpread(mlir::Type resultType,
-                            llvm::ArrayRef<fir::ExtendedValue> args) {
-
-  assert(args.size() == 3);
-
-  // Handle source argument
-  mlir::Value source = builder.createBox(loc, args[0]);
-  fir::BoxValue sourceTmp = source;
-  unsigned sourceRank = sourceTmp.rank();
-
-  // Handle Dim argument
-  mlir::Value dim = fir::getBase(args[1]);
-
-  // Handle ncopies argument
-  mlir::Value ncopies = fir::getBase(args[2]);
-
-  // Generate result descriptor
-  mlir::Type resultArrayType =
-      builder.getVarLenSeqTy(resultType, sourceRank + 1);
-  fir::MutableBoxValue resultMutableBox =
-      fir::factory::createTempMutableBox(builder, loc, resultArrayType);
-  mlir::Value resultIrBox =
-      fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
-
-  fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
-
-  return readAndAddCleanUp(resultMutableBox, resultType,
-                           "unexpected result for SPREAD");
-}
-
-// SUM
-fir::ExtendedValue
-IntrinsicLibrary::genSum(mlir::Type resultType,
-                         llvm::ArrayRef<fir::ExtendedValue> args) {
-  return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
-                      builder, loc, stmtCtx, "unexpected result for Sum", args);
+// SIGN
+mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 2);
+  if (resultType.isa<mlir::IntegerType>()) {
+    mlir::Value abs = genAbs(resultType, {args[0]});
+    mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
+    auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
+    auto cmp = builder.create<mlir::arith::CmpIOp>(
+        loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
+    return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
   }
-
-// SYSTEM_CLOCK
-void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
-  assert(args.size() == 3);
-  Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
-                                 fir::getBase(args[1]), fir::getBase(args[2]));
+  return genRuntimeCall("sign", resultType, args);
 }
 
 // SIZE
 fir::ExtendedValue
 IntrinsicLibrary::genSize(mlir::Type resultType,
                           llvm::ArrayRef<fir::ExtendedValue> args) {
   // Note that the value of the KIND argument is already reflected in the
   // resultType
return builder
         mlir::Value size = builder.createConvert(
             loc, resultType,
             fir::runtime::genSizeDim(builder, loc, array, dimValue));
         builder.create<fir::ResultOp>(loc, size);
       })
       .getResults()[0];
 }
 
+// SPREAD
+fir::ExtendedValue
+IntrinsicLibrary::genSpread(mlir::Type resultType,
+                            llvm::ArrayRef<fir::ExtendedValue> args) {
+
+  assert(args.size() == 3);
+
+  // Handle source argument
+  mlir::Value source = builder.createBox(loc, args[0]);
+  fir::BoxValue sourceTmp = source;
+  unsigned sourceRank = sourceTmp.rank();
+
+  // Handle Dim argument
+  mlir::Value dim = fir::getBase(args[1]);
+
+  // Handle ncopies argument
+  mlir::Value ncopies = fir::getBase(args[2]);
+
+  // Generate result descriptor
+  mlir::Type resultArrayType =
+      builder.getVarLenSeqTy(resultType, sourceRank + 1);
+  fir::MutableBoxValue resultMutableBox =
+      fir::factory::createTempMutableBox(builder, loc, resultArrayType);
+  mlir::Value resultIrBox =
+      fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+
+  fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
+
+  return readAndAddCleanUp(resultMutableBox, resultType,
+                           "unexpected result for SPREAD");
+}
+
+// SUM
+fir::ExtendedValue
+IntrinsicLibrary::genSum(mlir::Type resultType,
+                         llvm::ArrayRef<fir::ExtendedValue> args) {
+  return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
+                      builder, loc, stmtCtx, "unexpected result for Sum", args);
+}
+
+// SYSTEM_CLOCK
+void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 3);
+  Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
+                                 fir::getBase(args[1]), fir::getBase(args[2]));
+}
+
 // TRANSFER
 fir::ExtendedValue
 IntrinsicLibrary::genTransfer(mlir::Type resultType,
                               llvm::ArrayRef<fir::ExtendedValue> args) {
 
   assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
 
   // Handle source argument

flang/test/Lower/Intrinsics/aint.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPaint_test(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>{{.*}}, %[[VAL_1:.*]]: !fir.ref<f32>{{.*}}) {
+subroutine aint_test(a, b)
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32>
+! CHECK: %[[VAL_3:.*]] = fir.call @llvm.trunc.f32(%[[VAL_2]]) : (f32) -> f32
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK: return
+  real :: a, b
+  b = aint(a)
+end subroutine

flang/test/Lower/Intrinsics/anint.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: anint_test
+subroutine anint_test(a, b)
+  real :: a, b
+  ! CHECK: fir.call @llvm.round.f32
+  b = anint(a)
+end subroutine
+  
 No newline at end of file

flang/test/Lower/Intrinsics/cmplx.f90

+! This test focus on cmplx with Y argument that may turn out
+! to be absent at runtime because it is an unallocated allocatable,
+! a disassociated pointer, or an optional argument.
+! CMPLX without such argument is re-written by the front-end as a
+! complex constructor that is tested elsewhere.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPcmplx_test_scalar_ptr(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<f32>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>
+subroutine cmplx_test_scalar_ptr(x, y)
+  real :: x
+  real, pointer :: y
+  print *, cmplx(x, y)
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32>
+! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK:  %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.ptr<f32>) -> i64
+! CHECK:  %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:  %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:  %[[VAL_13:.*]] = fir.if %[[VAL_12]] -> (f32) {
+! CHECK:    %[[VAL_14:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK:    %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK:    %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ptr<f32>
+! CHECK:    fir.result %[[VAL_16]] : f32
+! CHECK:  } else {
+! CHECK:    %[[VAL_17:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK:    fir.result %[[VAL_17]] : f32
+! CHECK:  }
+! CHECK:  %[[VAL_18:.*]] = fir.undefined !fir.complex<4>
+! CHECK:  %[[VAL_19:.*]] = fir.insert_value %[[VAL_18]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+! CHECK:   fir.insert_value %[[VAL_19]], %[[VAL_21:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+end subroutine
+
+! CHECK-LABEL: func @_QPcmplx_test_scalar_optional(
+! CHECK-SAME:  %[[VAL_0:[^:]*]]: !fir.ref<f32>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<f32>
+subroutine cmplx_test_scalar_optional(x, y)
+  real :: x
+  real, optional :: y
+  print *, cmplx(x, y)
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32>
+! CHECK:  %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<f32>) -> i1
+! CHECK:  %[[VAL_9:.*]] = fir.if %[[VAL_8]] -> (f32) {
+! CHECK:    %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref<f32>
+! CHECK:    fir.result %[[VAL_10]] : f32
+! CHECK:  } else {
+! CHECK:    %[[VAL_11:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK:    fir.result %[[VAL_11]] : f32
+! CHECK:  }
+! CHECK:  %[[VAL_12:.*]] = fir.undefined !fir.complex<4>
+! CHECK:  %[[VAL_13:.*]] = fir.insert_value %[[VAL_12]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+! CHECK:  fir.insert_value %[[VAL_13]], %[[VAL_15:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+end subroutine
+
+! CHECK-LABEL: func @_QPcmplx_test_scalar_alloc_optional(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<f32>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<i64>>>
+subroutine cmplx_test_scalar_alloc_optional(x, y)
+  real :: x
+  integer(8), allocatable, optional :: y
+  print *, cmplx(x, y)
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32>
+! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<i64>>>
+! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<i64>>) -> !fir.heap<i64>
+! CHECK:  %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<i64>) -> i64
+! CHECK:  %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:  %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:  %[[VAL_13:.*]] = fir.if %[[VAL_12]] -> (i64) {
+! CHECK:    %[[VAL_14:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<i64>>>
+! CHECK:    %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box<!fir.heap<i64>>) -> !fir.heap<i64>
+! CHECK:    %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.heap<i64>
+! CHECK:    fir.result %[[VAL_16]] : i64
+! CHECK:  } else {
+! CHECK:    %[[VAL_17:.*]] = arith.constant 0 : i64
+! CHECK:    fir.result %[[VAL_17]] : i64
+! CHECK:  }
+! CHECK:  %[[VAL_18:.*]] = fir.convert %[[VAL_19:.*]] : (i64) -> f32
+! CHECK:  %[[VAL_20:.*]] = fir.undefined !fir.complex<4>
+! CHECK:  %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+! CHECK:  fir.insert_value %[[VAL_21]], %[[VAL_18]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+end subroutine
+
+! CHECK-LABEL: func @_QPcmplx_test_pointer_result(
+! CHECK-SAME:  %[[VAL_0:[^:]*]]: !fir.ref<f32>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<f32>
+subroutine cmplx_test_pointer_result(x, y)
+  real :: x
+  interface
+    function return_pointer()
+      real, pointer :: return_pointer
+    end function
+  end interface
+  print *, cmplx(x, return_pointer())
+! CHECK:  %[[VAL_9:.*]] = fir.call @_QPreturn_pointer() : () -> !fir.box<!fir.ptr<f32>>
+! CHECK:  fir.save_result %[[VAL_9]] to %[[VAL_2:.*]] : !fir.box<!fir.ptr<f32>>, !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK:  %[[VAL_10:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK:  %[[VAL_11:.*]] = fir.box_addr %[[VAL_10]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK:  %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ptr<f32>) -> i64
+! CHECK:  %[[VAL_13:.*]] = arith.constant 0 : i64
+! CHECK:  %[[VAL_14:.*]] = arith.cmpi ne, %[[VAL_12]], %[[VAL_13]] : i64
+! CHECK:  %[[VAL_15:.*]] = fir.if %[[VAL_14]] -> (f32) {
+! CHECK:    %[[VAL_16:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK:    %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK:    %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ptr<f32>
+! CHECK:    fir.result %[[VAL_18]] : f32
+! CHECK:  } else {
+! CHECK:    %[[VAL_19:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK:    fir.result %[[VAL_19]] : f32
+! CHECK:  }
+! CHECK:  %[[VAL_20:.*]] = fir.undefined !fir.complex<4>
+! CHECK:  %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_8]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+! CHECK:  fir.insert_value %[[VAL_21]], %[[VAL_23:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+end subroutine
+
+! CHECK-LABEL: func @_QPcmplx_array(
+! CHECK-SAME:  %[[VAL_0:[^:]*]]: !fir.box<!fir.array<?xf32>>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>>
+subroutine cmplx_array(x, y)
+  ! Important, note that the shape is taken from `x` and not `y` that
+  ! may be absent.
+  real :: x(:)
+  real, optional :: y(:)
+  print *, cmplx(x, y)
+! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_7]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_9:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+! CHECK:  %[[VAL_10:.*]] = fir.is_present %[[VAL_1]] : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK:  %[[VAL_11:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+! CHECK:  %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_14:.*]] = fir.embox %[[VAL_11]](%[[VAL_13]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:  %[[VAL_15:.*]] = arith.select %[[VAL_10]], %[[VAL_1]], %[[VAL_14]] : !fir.box<!fir.array<?xf32>>
+! CHECK:  %[[VAL_16:.*]] = fir.array_load %[[VAL_15]] {fir.optional} : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+! CHECK:  %[[VAL_17:.*]] = fir.allocmem !fir.array<?x!fir.complex<4>>, %[[VAL_8]]#1 {uniq_name = ".array.expr"}
+! CHECK:  %[[VAL_18:.*]] = fir.shape %[[VAL_8]]#1 : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_19:.*]] = fir.array_load %[[VAL_17]](%[[VAL_18]]) : (!fir.heap<!fir.array<?x!fir.complex<4>>>, !fir.shape<1>) -> !fir.array<?x!fir.complex<4>>
+! CHECK:  %[[VAL_20:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_21:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_22:.*]] = arith.subi %[[VAL_8]]#1, %[[VAL_20]] : index
+! CHECK:  %[[VAL_23:.*]] = fir.do_loop %[[VAL_24:.*]] = %[[VAL_21]] to %[[VAL_22]] step %[[VAL_20]] unordered iter_args(%[[VAL_25:.*]] = %[[VAL_19]]) -> (!fir.array<?x!fir.complex<4>>) {
+  ! CHECK:  %[[VAL_26:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_24]] : (!fir.array<?xf32>, index) -> f32
+  ! CHECK:  %[[VAL_27:.*]] = fir.if %[[VAL_10]] -> (f32) {
+    ! CHECK:  %[[VAL_28:.*]] = fir.array_fetch %[[VAL_16]], %[[VAL_24]] : (!fir.array<?xf32>, index) -> f32
+    ! CHECK:  fir.result %[[VAL_28]] : f32
+  ! CHECK:  } else {
+    ! CHECK:  %[[VAL_29:.*]] = arith.constant 0.000000e+00 : f32
+    ! CHECK:  fir.result %[[VAL_29]] : f32
+  ! CHECK:  }
+  ! CHECK:  %[[VAL_30:.*]] = fir.undefined !fir.complex<4>
+  ! CHECK:  %[[VAL_31:.*]] = fir.insert_value %[[VAL_30]], %[[VAL_26]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+  ! CHECK:  %[[VAL_32:.*]] = fir.insert_value %[[VAL_31]], %[[VAL_33:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+  ! CHECK:  %[[VAL_34:.*]] = fir.array_update %[[VAL_25]], %[[VAL_32]], %[[VAL_24]] : (!fir.array<?x!fir.complex<4>>, !fir.complex<4>, index) -> !fir.array<?x!fir.complex<4>>
+  ! CHECK:  fir.result %[[VAL_34]] : !fir.array<?x!fir.complex<4>>
+! CHECK:  }
+! CHECK:  fir.array_merge_store
+end subroutine

flang/test/Lower/Intrinsics/conjg.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: conjg_test
+subroutine conjg_test(z1, z2)
+  complex :: z1, z2
+  ! CHECK: fir.extract_value
+  ! CHECK: negf
+  ! CHECK: fir.insert_value
+  z2 = conjg(z1)
+end subroutine

flang/test/Lower/Intrinsics/dble.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: dble_test
+subroutine dble_test(a)
+  real :: a
+  ! CHECK: fir.convert {{.*}} : (f32) -> f64
+  print *, dble(a)
+end subroutine

flang/test/Lower/Intrinsics/dprod.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: dprod_test
+subroutine dprod_test (x, y, z)
+  real :: x,y
+  double precision :: z
+  z = dprod(x,y)
+  ! CHECK-DAG: %[[x:.*]] = fir.load %arg0
+  ! CHECK-DAG: %[[y:.*]] = fir.load %arg1
+  ! CHECK-DAG: %[[a:.*]] = fir.convert %[[x]] : (f32) -> f64
+  ! CHECK-DAG: %[[b:.*]] = fir.convert %[[y]] : (f32) -> f64
+  ! CHECK: %[[res:.*]] = arith.mulf %[[a]], %[[b]]
+  ! CHECK: fir.store %[[res]] to %arg2
+end subroutine

flang/test/Lower/Intrinsics/sign.f90

+! RUN: bbc %s -o - | FileCheck %s
+
+! CHECK-LABEL: sign_testi
+subroutine sign_testi(a, b, c)
+  integer a, b, c
+  ! CHECK: %[[VAL_1:.*]] = arith.shrsi %{{.*}}, %{{.*}} : i32
+  ! CHECK: %[[VAL_2:.*]] = arith.xori %{{.*}}, %[[VAL_1]] : i32
+  ! CHECK: %[[VAL_3:.*]] = arith.subi %[[VAL_2]], %[[VAL_1]] : i32
+  ! CHECK-DAG: %[[VAL_4:.*]] = arith.subi %{{.*}}, %[[VAL_3]] : i32
+  ! CHECK-DAG: %[[VAL_5:.*]] = arith.cmpi slt, %{{.*}}, %{{.*}} : i32
+  ! CHECK: select %[[VAL_5]], %[[VAL_4]], %[[VAL_3]] : i32
+  c = sign(a, b)
+end subroutine
+
+! CHECK-LABEL: sign_testr
+subroutine sign_testr(a, b, c)
+  real a, b, c
+  ! CHECK-NOT: fir.call @{{.*}}fabs
+  ! CHECK: fir.call @{{.*}}copysign{{.*}} : (f32, f32) -> f32
+  c = sign(a, b)
+end subroutine
+
+! CHECK-LABEL: sign_testr2
+subroutine sign_testr2(a, b, c)
+  real(KIND=16) a, b, c
+  ! CHECK-NOT: fir.call @{{.*}}fabs
+  ! CHECK: fir.call @{{.*}}copysign{{.*}} : (f128, f128) -> f128
+  c = sign(a, b)
+end subroutine