diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index 44ae5b1a4d30a..56413659d35ae 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -235,6 +235,7 @@ struct IntrinsicLibrary { /// real and to the `hypot` math routine if the argument is of complex type. mlir::Value genAbs(mlir::Type, llvm::ArrayRef); mlir::Value genAimag(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); @@ -316,6 +317,7 @@ struct IntrinsicHandler { }; constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value; +constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr; constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box; constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired; using I = IntrinsicLibrary; @@ -335,6 +337,10 @@ static constexpr bool handleDynamicOptional = true; static constexpr IntrinsicHandler handlers[]{ {"abs", &I::genAbs}, {"aimag", &I::genAimag}, + {"all", + &I::genAll, + {{{"mask", asAddr}, {"dim", asValue}}}, + /*isElemental=*/false}, {"associated", &I::genAssociated, {{{"pointer", asInquired}, {"target", asInquired}}}, @@ -1067,6 +1073,52 @@ mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, args[0], true /* isImagPart */); } +// ALL +fir::ExtendedValue +IntrinsicLibrary::genAll(mlir::Type resultType, + llvm::ArrayRef args) { + + assert(args.size() == 2); + // Handle required mask argument + mlir::Value mask = builder.createBox(loc, args[0]); + + fir::BoxValue maskArry = builder.createBox(loc, args[0]); + int rank = maskArry.rank(); + assert(rank >= 1); + + // Handle optional dim argument + bool absentDim = isAbsent(args[1]); + mlir::Value dim = + absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) + : fir::getBase(args[1]); + + if (rank == 1 || absentDim) + return builder.createConvert(loc, resultType, + fir::runtime::genAll(builder, loc, mask, dim)); + + // else use the result descriptor AllDim() intrinsic + + // Create mutable fir.box to be passed to the runtime for the result. + + mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); + fir::MutableBoxValue resultMutableBox = + fir::factory::createTempMutableBox(builder, loc, resultArrayType); + mlir::Value resultIrBox = + fir::factory::getMutableIRBox(builder, loc, resultMutableBox); + + // Call runtime. The runtime is allocating the result. + fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim); + return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox) + .match( + [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue { + addCleanUpForTemp(loc, box.getAddr()); + return box; + }, + [&](const auto &) -> fir::ExtendedValue { + fir::emitFatalError(loc, "Invalid result for ALL"); + }); +} + // ASSOCIATED fir::ExtendedValue IntrinsicLibrary::genAssociated(mlir::Type resultType, diff --git a/flang/test/Lower/Intrinsics/all.f90 b/flang/test/Lower/Intrinsics/all.f90 new file mode 100644 index 0000000000000..35188d9ccd043 --- /dev/null +++ b/flang/test/Lower/Intrinsics/all.f90 @@ -0,0 +1,31 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: all_test +! CHECK-SAME: %[[arg0:.*]]: !fir.box>>{{.*}}) -> !fir.logical<4> +logical function all_test(mask) +logical :: mask(:) +! CHECK: %[[c1:.*]] = arith.constant 1 : index +! CHECK: %[[a1:.*]] = fir.convert %[[arg0]] : (!fir.box>>) -> !fir.box +! CHECK: %[[a2:.*]] = fir.convert %[[c1]] : (index) -> i32 +all_test = all(mask) +! CHECK: %[[a3:.*]] = fir.call @_FortranAAll(%[[a1]], %{{.*}}, %{{.*}}, %[[a2]]) : (!fir.box, !fir.ref, i32, i32) -> i1 +end function all_test + +! CHECK-LABEL: all_test2 +! CHECK-SAME: %[[arg0:.*]]: !fir.box>> +! CHECK-SAME: %[[arg1:.*]]: !fir.ref +! CHECK-SAME: %[[arg2:.*]]: !fir.box>> +subroutine all_test2(mask, d, rslt) +logical :: mask(:,:) +integer :: d +logical :: rslt(:) +! CHECK: %[[a0:.*]] = fir.alloca !fir.box>>> +! CHECK: %[[a1:.*]] = fir.load %[[arg1:.*]] : !fir.ref +! CHECK: %[[a6:.*]] = fir.convert %[[a0:.*]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[a7:.*]] = fir.convert %[[arg0:.*]]: (!fir.box>>) -> !fir.box +rslt = all(mask, d) +! CHECK: %[[r1:.*]] = fir.call @_FortranAAllDim(%[[a6:.*]], %[[a7:.*]], %[[a1:.*]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> none +! CHECK: %[[a10:.*]] = fir.load %[[a0:.*]] : !fir.ref>>>> +! CHECK: %[[a12:.*]] = fir.box_addr %[[a10:.*]] : (!fir.box>>>) -> !fir.heap>> +! CHECK: fir.freemem %[[a12:.*]] +end subroutine