[flang] Support lowering of IS_CONTIGUOUS

This supports the lowering of intrinsic IS_CONTIGUOUS for array argument.
The argument of assumed rank is not supported since it is not implemented
yet as the procedure argument. Add TODO for it.

Reviewed By: PeteSteinfeld, jeanPerier

Differential Revision: https://reviews.llvm.org/D141212

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h b/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h
index 7e07cc9..132592a 100644 (file)
--- a/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h
@@ -42,5 +42,9 @@ mlir::Value genSize(fir::FirOpBuilder &builder, mlir::Location loc,
 mlir::Value genSizeDim(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value array, mlir::Value dim);
 
+/// Generate call to `Is_contiguous` runtime routine.
+mlir::Value genIsContiguous(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value array);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_INQUIRY_H

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index fc698e0..da80abd 100644 (file)
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -38,6 +38,7 @@
 #include "flang/Optimizer/Builder/Runtime/Assign.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Runtime/Derived.h"
+#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/Ragged.h"
 #include "flang/Optimizer/Builder/Todo.h"
@@ -2165,14 +2166,8 @@ public:
 
     if (isActualArgBox) {
       // Check at runtime if the argument is contiguous so no copy is needed.
-      mlir::func::FuncOp isContiguousFct =
-          fir::runtime::getRuntimeFunc<mkRTKey(IsContiguous)>(loc, builder);
-      fir::CallOp isContiguous = builder.create<fir::CallOp>(
-          loc, isContiguousFct,
-          mlir::ValueRange{builder.createConvert(
-              loc, isContiguousFct.getFunctionType().getInput(0),
-              fir::getBase(actualArg))});
-      isContiguousResult = isContiguous.getResult(0);
+      isContiguousResult =
+          fir::runtime::genIsContiguous(builder, loc, fir::getBase(actualArg));
     }
 
     auto doCopyIn = [&]() -> ExtValue {

diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 4258ad7..35183f8 100644 (file)
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -529,6 +529,8 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genIsContiguous(mlir::Type,
+                                     llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -893,6 +895,10 @@ static constexpr IntrinsicHandler handlers[]{
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"is_contiguous",
+     &I::genIsContiguous,
+     {{{"array", asBox}}},
+     /*isElemental=*/false},
     {"ishft", &I::genIshft},
     {"ishftc", &I::genIshftc},
     {"lbound",
@@ -3836,6 +3842,20 @@ IntrinsicLibrary::genIparity(mlir::Type resultType,
                       "unexpected result for IPARITY", args);
 }
 
+// IS_CONTIGUOUS
+fir::ExtendedValue
+IntrinsicLibrary::genIsContiguous(mlir::Type resultType,
+                                  llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1);
+  if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
+    if (boxValue->hasAssumedRank())
+      TODO(loc, "intrinsic: is_contiguous with assumed rank argument");
+
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0])));
+}
+
 // ISHFT
 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {

diff --git a/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp b/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp
index 7b9e6ab..16f63be 100644 (file)
--- a/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp
@@ -10,6 +10,7 @@
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Runtime/inquiry.h"
+#include "flang/Runtime/support.h"
 
 using namespace Fortran::runtime;
 
@@ -75,3 +76,14 @@ mlir::Value fir::runtime::genSize(fir::FirOpBuilder &builder,
                                             sourceFile, sourceLine);
   return builder.create<fir::CallOp>(loc, sizeFunc, args).getResult(0);
 }
+
+/// Generate call to `Is_contiguous` runtime routine.
+mlir::Value fir::runtime::genIsContiguous(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          mlir::Value array) {
+  mlir::func::FuncOp isContiguousFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(IsContiguous)>(loc, builder);
+  auto fTy = isContiguousFunc.getFunctionType();
+  auto args = fir::runtime::createArguments(builder, loc, fTy, array);
+  return builder.create<fir::CallOp>(loc, isContiguousFunc, args).getResult(0);
+}

diff --git a/flang/test/Lower/Intrinsics/is_contiguous.f90 b/flang/test/Lower/Intrinsics/is_contiguous.f90
new file mode 100644 (file)
index 0000000..e01348e
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/is_contiguous.f90
@@ -0,0 +1,30 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_is_contiguous(
+! CHECK-SAME:                                   %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.logical<4> {adapt.valuebyref}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.logical<4> {adapt.valuebyref}
+! CHECK:         %[[VAL_5:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p", uniq_name = "_QFtest_is_contiguousEp"}
+! CHECK:         %[[VAL_42:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK:         %[[VAL_43:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_42]]) {{.*}} : (!fir.box<none>) -> i1
+! CHECK:         %[[VAL_44:.*]] = fir.convert %[[VAL_43]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_44]] to %[[VAL_2]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPfoo1(%[[VAL_2]]) {{.*}} : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK:         %[[VAL_45:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:         %[[VAL_46:.*]] = fir.convert %[[VAL_45]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK:         %[[VAL_47:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_46]]) {{.*}} : (!fir.box<none>) -> i1
+! CHECK:         %[[VAL_48:.*]] = fir.convert %[[VAL_47]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_48]] to %[[VAL_1]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPfoo2(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_is_contiguous(a)
+  real :: a(:)
+  real, pointer :: p(:)
+
+  call bar(p)
+
+  call foo1(is_contiguous(a))
+  call foo2(is_contiguous(p))
+end