diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h b/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h index 7e07cc9663340..132592a0197f8 100644 --- 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 fc698e00c3026..da80abdcb951c 100644 --- 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 @@ class ScalarExprLowering { if (isActualArgBox) { // Check at runtime if the argument is contiguous so no copy is needed. - mlir::func::FuncOp isContiguousFct = - fir::runtime::getRuntimeFunc(loc, builder); - fir::CallOp isContiguous = builder.create( - 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 4258ad73f0df8..35183f82f68dd 100644 --- 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); mlir::Value genIor(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genIsContiguous(mlir::Type, + llvm::ArrayRef); mlir::Value genIshft(mlir::Type, llvm::ArrayRef); mlir::Value genIshftc(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef); @@ -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 args) { + assert(args.size() == 1); + if (const auto *boxValue = args[0].getBoxOf()) + 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 args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp b/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp index 7b9e6ab7e479d..16f63bea4617a 100644 --- 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(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(loc, builder); + auto fTy = isContiguousFunc.getFunctionType(); + auto args = fir::runtime::createArguments(builder, loc, fTy, array); + return builder.create(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 index 0000000000000..e01348edcc5eb --- /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.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>> {bindc_name = "p", uniq_name = "_QFtest_is_contiguousEp"} +! CHECK: %[[VAL_42:.*]] = fir.convert %[[VAL_0]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_42]]) {{.*}} : (!fir.box) -> i1 +! CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_43]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_44]] to %[[VAL_2]] : !fir.ref> +! CHECK: fir.call @_QPfoo1(%[[VAL_2]]) {{.*}} : (!fir.ref>) -> () +! CHECK: %[[VAL_45:.*]] = fir.load %[[VAL_5]] : !fir.ref>>> +! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_45]] : (!fir.box>>) -> !fir.box +! CHECK: %[[VAL_47:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_46]]) {{.*}} : (!fir.box) -> i1 +! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_47]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_48]] to %[[VAL_1]] : !fir.ref> +! CHECK: fir.call @_QPfoo2(%[[VAL_1]]) {{.*}} : (!fir.ref>) -> () +! 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