[flang] Lower MOD to Fortran runtime call.

[vzakhari]

Summary

This change removes dependency on pgmath mod, and also allows
Fortran runtime to issue a diagnostic message in case of zero
denominator.

[jeanPerier]

Looks good to me

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

311

Isn't it safe to upcast the arguments to use the ModReal4 version and to downcast the result in those cases ?

[clementval]

LGTM

[klausler]

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

311

That's risky, since there would be an extra rounding, and MOD should be exact.

It's possible to check the whole range of 16-bit operand value pairs for safety.

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

 /// Generate call to Exponent intrinsic runtime routine.
 mlir::Value genExponent(fir::FirOpBuilder &builder, mlir::Location loc,
                         mlir::Type resultType, mlir::Value x);
 
 /// Generate call to Fraction intrinsic runtime routine.
 mlir::Value genFraction(fir::FirOpBuilder &builder, mlir::Location loc,
                         mlir::Value x);
 
+/// Generate call to Mod intrinsic runtime routine.
+mlir::Value genMod(fir::FirOpBuilder &builder, mlir::Location loc,
+                   mlir::Value a, mlir::Value p);
+
 /// Generate call to Nearest intrinsic runtime routine.
 mlir::Value genNearest(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value x, mlir::Value s);
 
 /// Generate call to RRSpacing intrinsic runtime routine.
 mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value x);
 

flang/lib/Lower/IntrinsicCall.cpp

 
 // MOD
 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
                                      llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
   if (resultType.isa<mlir::IntegerType>())
     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
 
-  // Use runtime. Note that mlir::arith::RemFOp implements floating point
-  // remainder, but it does not work with fir::Real type.
-  // TODO: consider using mlir::arith::RemFOp when possible, that may help
-  // folding and  optimizations.
-  return genRuntimeCall("mod", resultType, args);
+  // Use runtime.
+  return builder.createConvert(
+      loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1]));
 }
 
 // MODULO
 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
                                         llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
   // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
   // In the meantime, use a simple inlined implementation based on truncated

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

struct ForcedFraction16 {
   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctx) {
       auto ty = mlir::FloatType::getF128(ctx);
       return mlir::FunctionType::get(ctx, {ty}, {ty});
     };
   }
 };
 
+/// Placeholder for real*10 version of Mod Intrinsic
+struct ForcedMod10 {
+  static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal10));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto fltTy = mlir::FloatType::getF80(ctx);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
+                                     {fltTy});
+    };
+  }
+};
+
+/// Placeholder for real*16 version of Mod Intrinsic
+struct ForcedMod16 {
+  static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto fltTy = mlir::FloatType::getF128(ctx);
+      auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+      auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+      return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
+                                     {fltTy});
+    };
+  }
+};
+
 /// Placeholder for real*10 version of Nearest Intrinsic
 struct ForcedNearest10 {
   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));
   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctx) {
       auto fltTy = mlir::FloatType::getF80(ctx);
       auto boolTy = mlir::IntegerType::get(ctx, 1);
       return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
mlir::Value fir::runtime::genFraction(fir::FirOpBuilder &builder,
 
   auto funcTy = func.getFunctionType();
   llvm::SmallVector<mlir::Value> args = {
       builder.createConvert(loc, funcTy.getInput(0), x)};
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+/// Generate call to Mod intrinsic runtime routine.
+mlir::Value fir::runtime::genMod(fir::FirOpBuilder &builder, mlir::Location loc,
+                                 mlir::Value a, mlir::Value p) {
+  mlir::func::FuncOp func;
+  mlir::Type fltTy = a.getType();
+
+  if (fltTy != p.getType())
+    fir::emitFatalError(loc, "arguments type mismatch in MOD");
+
+  if (fltTy.isF16())
+    TODO(loc, "support for REAL with KIND = 2 in MOD");
+  else if (fltTy.isF32())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal4)>(loc, builder);
+  else if (fltTy.isF64())
+    func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal8)>(loc, builder);
+  else if (fltTy.isF80())
+    func = fir::runtime::getRuntimeFunc<ForcedMod10>(loc, builder);
+  else if (fltTy.isF128())
+    func = fir::runtime::getRuntimeFunc<ForcedMod16>(loc, builder);
+  else
+    fir::emitFatalError(loc, "unsupported REAL kind in MOD");
+
+  auto funcTy = func.getFunctionType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));
+  auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,
+                                            sourceFile, sourceLine);
+
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
+
 /// Generate call to Nearest intrinsic runtime routine.
 mlir::Value fir::runtime::genNearest(fir::FirOpBuilder &builder,
                                      mlir::Location loc, mlir::Value x,
                                      mlir::Value s) {
   mlir::func::FuncOp func;
   mlir::Type fltTy = x.getType();
 
   if (fltTy.isF16())

flang/test/Lower/Intrinsics/mod.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPmod_testr4(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f32>{{.*}}, %[[arg1:.*]]: !fir.ref<f32>{{.*}}, %[[arg2:.*]]: !fir.ref<f32>{{.*}}) {
+subroutine mod_testr4(r, a, p)
+  real(4) :: r, a, p
+! CHECK: %[[V1:.*]] = fir.load %[[arg1]] : !fir.ref<f32>
+! CHECK: %[[V2:.*]] = fir.load %[[arg2]] : !fir.ref<f32>
+! CHECK: %[[FILE:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! CHECK: %[[LINE:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK: %[[FILEARG:.*]] = fir.convert %[[FILE]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAModReal4(%[[V1]], %[[V2]], %[[FILEARG]], %[[LINE]]) : (f32, f32, !fir.ref<i8>, i32) -> f32
+  r = mod(a, p)
+end subroutine
+
+! CHECK-LABEL: func @_QPmod_testr8(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f64>{{.*}}, %[[arg1:.*]]: !fir.ref<f64>{{.*}}, %[[arg2:.*]]: !fir.ref<f64>{{.*}}) {
+subroutine mod_testr8(r, a, p)
+  real(8) :: r, a, p
+! CHECK: %[[V1:.*]] = fir.load %[[arg1]] : !fir.ref<f64>
+! CHECK: %[[V2:.*]] = fir.load %[[arg2]] : !fir.ref<f64>
+! CHECK: %[[FILE:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! CHECK: %[[LINE:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK: %[[FILEARG:.*]] = fir.convert %[[FILE]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAModReal8(%[[V1]], %[[V2]], %[[FILEARG]], %[[LINE]]) : (f64, f64, !fir.ref<i8>, i32) -> f64
+  r = mod(a, p)
+end subroutine
+
+! CHECK-LABEL: func @_QPmod_testr10(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f80>{{.*}}, %[[arg1:.*]]: !fir.ref<f80>{{.*}}, %[[arg2:.*]]: !fir.ref<f80>{{.*}}) {
+subroutine mod_testr10(r, a, p)
+  real(10) :: r, a, p
+! CHECK: %[[V1:.*]] = fir.load %[[arg1]] : !fir.ref<f80>
+! CHECK: %[[V2:.*]] = fir.load %[[arg2]] : !fir.ref<f80>
+! CHECK: %[[FILE:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! CHECK: %[[LINE:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK: %[[FILEARG:.*]] = fir.convert %[[FILE]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAModReal10(%[[V1]], %[[V2]], %[[FILEARG]], %[[LINE]]) : (f80, f80, !fir.ref<i8>, i32) -> f80
+  r = mod(a, p)
+end subroutine
+
+! CHECK-LABEL: func @_QPmod_testr16(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f128>{{.*}}, %[[arg1:.*]]: !fir.ref<f128>{{.*}}, %[[arg2:.*]]: !fir.ref<f128>{{.*}}) {
+subroutine mod_testr16(r, a, p)
+  real(16) :: r, a, p
+! CHECK: %[[V1:.*]] = fir.load %[[arg1]] : !fir.ref<f128>
+! CHECK: %[[V2:.*]] = fir.load %[[arg2]] : !fir.ref<f128>
+! CHECK: %[[FILE:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! CHECK: %[[LINE:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK: %[[FILEARG:.*]] = fir.convert %[[FILE]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAModReal16(%[[V1]], %[[V2]], %[[FILEARG]], %[[LINE]]) : (f128, f128, !fir.ref<i8>, i32) -> f128
+  r = mod(a, p)
+end subroutine