diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -236,6 +236,7 @@ mlir::Value genAbs(mlir::Type, llvm::ArrayRef); mlir::Value genAimag(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); @@ -341,6 +342,10 @@ &I::genAll, {{{"mask", asAddr}, {"dim", asValue}}}, /*isElemental=*/false}, + {"any", + &I::genAny, + {{{"mask", asAddr}, {"dim", asValue}}}, + /*isElemental=*/false}, {"associated", &I::genAssociated, {{{"pointer", asInquired}, {"target", asInquired}}}, @@ -1119,6 +1124,52 @@ }); } +// ANY +fir::ExtendedValue +IntrinsicLibrary::genAny(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::genAny(builder, loc, mask, dim)); + + // else use the result descriptor AnyDim() 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::genAnyDescriptor(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 ANY"); + }); +} + // ASSOCIATED fir::ExtendedValue IntrinsicLibrary::genAssociated(mlir::Type resultType, diff --git a/flang/test/Lower/Intrinsics/any.f90 b/flang/test/Lower/Intrinsics/any.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/any.f90 @@ -0,0 +1,31 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: any_test +! CHECK-SAME: %[[arg0:.*]]: !fir.box>>{{.*}}) -> !fir.logical<4> +logical function any_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 +any_test = any(mask) +! CHECK: %[[a3:.*]] = fir.call @_FortranAAny(%[[a1]], %{{.*}}, %{{.*}}, %[[a2]]) : (!fir.box, !fir.ref, i32, i32) -> i1 +end function any_test + +! CHECK-LABEL: any_test2 +! CHECK-SAME: %[[arg0:.*]]: !fir.box>> +! CHECK-SAME: %[[arg1:.*]]: !fir.ref +! CHECK-SAME: %[[arg2:.*]]: !fir.box>> +subroutine any_test2(mask, d, rslt) +logical :: mask(:,:) +integer :: d +logical :: rslt(:) +! CHECK-DAG: %[[a0:.*]] = fir.alloca !fir.box>>> +! CHECK-DAG: %[[a1:.*]] = fir.load %[[arg1:.*]] : !fir.ref +! CHECK-DAG: %[[a6:.*]] = fir.convert %[[a0:.*]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK-DAG: %[[a7:.*]] = fir.convert %[[arg0:.*]]: (!fir.box>>) -> !fir.box +rslt = any(mask, d) +! CHECK: %[[r1:.*]] = fir.call @_FortranAAnyDim(%[[a6:.*]], %[[a7:.*]], %[[a1:.*]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> none +! CHECK-DAG: %[[a10:.*]] = fir.load %[[a0:.*]] : !fir.ref>>>> +! CHECK-DAG: %[[a12:.*]] = fir.box_addr %[[a10:.*]] : (!fir.box>>>) -> !fir.heap>> +! CHECK-DAG fir.freemem %[[a12:.*]] +end subroutine