diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h --- a/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Reduction.h @@ -39,6 +39,13 @@ mlir::Value resultBox, mlir::Value maskBox, mlir::Value dim); +/// Generate call to `ParityDim` runtime routine. +/// This calls the descriptor based runtime call implementation of the `parity` +/// intrinsic. +void genParityDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value maskBox, + mlir::Value dim); + /// Generate call to `All` runtime routine. This version of `all` is specialized /// for rank 1 mask arguments. /// This calls the version that returns a scalar logical value. @@ -128,6 +135,12 @@ mlir::Value resultBox, mlir::Value arrayBox, mlir::Value dim, mlir::Value maskBox); +/// Generate call to `Parity` runtime routine. This version of `parity` is +/// specialized for rank 1 mask arguments. +/// This calls the version that returns a scalar logical value. +mlir::Value genParity(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value maskBox, mlir::Value dim); + /// Generate call to `Product` intrinsic runtime routine. This is the version /// that does not take a dim argument. mlir::Value genProduct(fir::FirOpBuilder &builder, mlir::Location loc, 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 @@ -535,6 +535,7 @@ mlir::Value genNot(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genParity(mlir::Type, llvm::ArrayRef); mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef); mlir::Value genPoppar(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef); @@ -882,6 +883,10 @@ {"mask", asBox}, {"vector", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"parity", + &I::genParity, + {{{"mask", asBox}, {"dim", asValue}}}, + /*isElemental=*/false}, {"popcnt", &I::genPopcnt}, {"poppar", &I::genPoppar}, {"present", @@ -3631,6 +3636,52 @@ "unexpected result for PACK"); } +// PARITY +fir::ExtendedValue +IntrinsicLibrary::genParity(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 = isStaticallyAbsent(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::genParity(builder, loc, mask, dim)); + + // else use the result descriptor ParityDim() 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::genParityDescriptor(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 PARITY"); + }); +} + // POPCNT mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp --- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp @@ -471,6 +471,18 @@ genReduction2Args(anyFunc, builder, loc, resultBox, maskBox, dim); } +/// Generate call to `ParityDim` runtime routine. +/// This calls the descriptor based runtime call implementation of the `parity` +/// intrinsic. +void fir::runtime::genParityDescriptor(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value resultBox, + mlir::Value maskBox, mlir::Value dim) { + auto parityFunc = + fir::runtime::getRuntimeFunc(loc, builder); + genReduction2Args(parityFunc, builder, loc, resultBox, maskBox, dim); +} + /// Generate call to `All` intrinsic runtime routine. This routine is /// specialized for mask arguments with rank == 1. mlir::Value fir::runtime::genAll(fir::FirOpBuilder &builder, mlir::Location loc, @@ -694,6 +706,15 @@ return builder.create(loc, func, args).getResult(0); } +/// Generate call to `Parity` intrinsic runtime routine. This routine is +/// specialized for mask arguments with rank == 1. +mlir::Value fir::runtime::genParity(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value maskBox, + mlir::Value dim) { + auto parityFunc = fir::runtime::getRuntimeFunc(loc, builder); + return genSpecial2Args(parityFunc, builder, loc, maskBox, dim); +} + /// Generate call to `ProductDim` intrinsic runtime routine. This is the version /// that handles any rank array with the dim argument specified. void fir::runtime::genProductDim(fir::FirOpBuilder &builder, mlir::Location loc, diff --git a/flang/test/Lower/Intrinsics/parity.f90 b/flang/test/Lower/Intrinsics/parity.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/parity.f90 @@ -0,0 +1,32 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: parity_test +! CHECK-SAME: %[[arg0:.*]]: !fir.box>>{{.*}}) -> !fir.logical<4> +logical function parity_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 + parity_test = parity(mask) + ! CHECK: %[[a3:.*]] = fir.call @_FortranAParity(%[[a1]], %{{.*}}, %{{.*}}, %[[a2]]) : (!fir.box, !fir.ref, i32, i32) -> i1 +end function parity_test + +! CHECK-LABEL: parity_test2 +! CHECK-SAME: %[[arg0:.*]]: !fir.box>> +! CHECK-SAME: %[[arg1:.*]]: !fir.ref +! CHECK-SAME: %[[arg2:.*]]: !fir.box>> +subroutine parity_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 = parity(mask, d) + ! CHECK: %[[r1:.*]] = fir.call @_FortranAParityDim(%[[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 parity_test2 diff --git a/flang/unittests/Optimizer/Builder/Runtime/ReductionTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/ReductionTest.cpp --- a/flang/unittests/Optimizer/Builder/Runtime/ReductionTest.cpp +++ b/flang/unittests/Optimizer/Builder/Runtime/ReductionTest.cpp @@ -112,6 +112,23 @@ testGenMinVal(*firBuilder, i128Ty, "_FortranAMinvalInteger16"); } +TEST_F(RuntimeCallTest, genParityTest) { + mlir::Location loc = firBuilder->getUnknownLoc(); + mlir::Value undef = firBuilder->create(loc, seqTy10); + mlir::Value dim = firBuilder->createIntegerConstant(loc, i32Ty, 1); + mlir::Value parity = fir::runtime::genParity(*firBuilder, loc, undef, dim); + checkCallOp(parity.getDefiningOp(), "_FortranAParity", 2); +} + +TEST_F(RuntimeCallTest, genParityDescriptorTest) { + mlir::Location loc = firBuilder->getUnknownLoc(); + mlir::Value result = firBuilder->create(loc, seqTy10); + mlir::Value mask = firBuilder->create(loc, seqTy10); + mlir::Value dim = firBuilder->createIntegerConstant(loc, i32Ty, 1); + fir::runtime::genParityDescriptor(*firBuilder, loc, result, mask, dim); + checkCallOpFromResultBox(result, "_FortranAParityDim", 3); +} + void testGenSum( fir::FirOpBuilder &builder, mlir::Type eleTy, llvm::StringRef fctName) { mlir::Location loc = builder.getUnknownLoc();