diff --git a/flang/runtime/reduction.h b/flang/runtime/reduction.h --- a/flang/runtime/reduction.h +++ b/flang/runtime/reduction.h @@ -24,8 +24,8 @@ extern "C" { // Reductions that are known to return scalars have per-type entry -// points. These cover the casse that either have no DIM= -// argument, or have an argument rank of 1. Pass 0 for no DIM= +// points. These cover the cases that either have no DIM= +// argument or have an argument rank of 1. Pass 0 for no DIM= // or the value of the DIM= argument so that it may be checked. // The data type in the descriptor is checked against the expected // return type. @@ -144,20 +144,42 @@ void RTNAME(ProductDim)(Descriptor &result, const Descriptor &array, int dim, const char *source, int line, const Descriptor *mask = nullptr); -// MAXLOC and MINLOC +// IPARITY() +std::int8_t RTNAME(IParity1)(const Descriptor &, const char *source, int line, + int dim = 0, const Descriptor *mask = nullptr); +std::int16_t RTNAME(IParity2)(const Descriptor &, const char *source, int line, + int dim = 0, const Descriptor *mask = nullptr); +std::int32_t RTNAME(IParity4)(const Descriptor &, const char *source, int line, + int dim = 0, const Descriptor *mask = nullptr); +std::int64_t RTNAME(IParity8)(const Descriptor &, const char *source, int line, + int dim = 0, const Descriptor *mask = nullptr); +#ifdef __SIZEOF_INT128__ +common::int128_t RTNAME(IParity16)(const Descriptor &, const char *source, + int line, int dim = 0, const Descriptor *mask = nullptr); +#endif +void RTNAME(IParityDim)(Descriptor &result, const Descriptor &array, int dim, + const char *source, int line, const Descriptor *mask = nullptr); + +// FINDLOC, MAXLOC, & MINLOC // These return allocated arrays in the supplied descriptor. // The default value for KIND= should be the default INTEGER in effect at // compilation time. -void RTNAME(Maxloc)(Descriptor &, const Descriptor &, int kind, +void RTNAME(Findloc)(Descriptor &, const Descriptor &x, + const Descriptor &target, int kind, const char *source, int line, + const Descriptor *mask = nullptr, bool back = false); +void RTNAME(FindlocDim)(Descriptor &, const Descriptor &x, + const Descriptor &target, int kind, int dim, const char *source, int line, + const Descriptor *mask = nullptr, bool back = false); +void RTNAME(Maxloc)(Descriptor &, const Descriptor &x, int kind, const char *source, int line, const Descriptor *mask = nullptr, bool back = false); -void RTNAME(MaxlocDim)(Descriptor &, const Descriptor &, int kind, int dim, +void RTNAME(MaxlocDim)(Descriptor &, const Descriptor &x, int kind, int dim, const char *source, int line, const Descriptor *mask = nullptr, bool back = false); -void RTNAME(Minloc)(Descriptor &, const Descriptor &, int kind, +void RTNAME(Minloc)(Descriptor &, const Descriptor &x, int kind, const char *source, int line, const Descriptor *mask = nullptr, bool back = false); -void RTNAME(MinlocDim)(Descriptor &, const Descriptor &, int kind, int dim, +void RTNAME(MinlocDim)(Descriptor &, const Descriptor &x, int kind, int dim, const char *source, int line, const Descriptor *mask = nullptr, bool back = false); @@ -221,7 +243,7 @@ void RTNAME(MinvalDim)(Descriptor &, const Descriptor &, int dim, const char *source, int line, const Descriptor *mask = nullptr); -// ALL, ANY, & COUNT logical reductions +// ALL, ANY, COUNT, & PARITY logical reductions bool RTNAME(All)(const Descriptor &, const char *source, int line, int dim = 0); void RTNAME(AllDim)(Descriptor &result, const Descriptor &, int dim, const char *source, int line); @@ -232,6 +254,10 @@ const Descriptor &, const char *source, int line, int dim = 0); void RTNAME(CountDim)(Descriptor &result, const Descriptor &, int dim, int kind, const char *source, int line); +bool RTNAME(Parity)( + const Descriptor &, const char *source, int line, int dim = 0); +void RTNAME(ParityDim)(Descriptor &result, const Descriptor &, int dim, + const char *source, int line); } // extern "C" } // namespace Fortran::runtime diff --git a/flang/runtime/reduction.cpp b/flang/runtime/reduction.cpp --- a/flang/runtime/reduction.cpp +++ b/flang/runtime/reduction.cpp @@ -6,9 +6,9 @@ // //===----------------------------------------------------------------------===// -// Implements ALL, ANY, COUNT, MAXLOC, MAXVAL, MINLOC, MINVAL, PRODUCT, and SUM -// for all required operand types and shapes and (for MAXLOC & MINLOC) kinds of -// results. +// Implements ALL, ANY, COUNT, FINDLOC, IPARITY, MAXLOC, MAXVAL, MINLOC, MINVAL, +// PARITY, PRODUCT, and SUM for all required operand types and shapes and, +// for FINDLOC, MAXLOC, & MINLOC, kinds of results. // // * Real and complex SUM reductions attempt to reduce floating-point // cancellation on intermediate results by adding up partial sums @@ -16,7 +16,7 @@ // * Partial reductions (i.e., those with DIM= arguments that are not // required to be 1 by the rank of the argument) return arrays that // are dynamically allocated in a caller-supplied descriptor. -// * Total reductions (i.e., no DIM= argument) with MAXLOC & MINLOC +// * Total reductions (i.e., no DIM= argument) with FINDLOC, MAXLOC, & MINLOC // return integer vectors of some kind, not scalars; a caller-supplied // descriptor is used // * Character-valued reductions (MAXVAL & MINVAL) return arbitrary @@ -46,8 +46,8 @@ // member function that copies a final result into its destination. // Total reduction of the array argument to a scalar (or to a vector in the -// cases of MAXLOC & MINLOC). These are the cases without DIM= or cases -// where the argument has rank 1 and DIM=, if present, must be 1. +// cases of FINDLOC, MAXLOC, & MINLOC). These are the cases without DIM= or +// cases where the argument has rank 1 and DIM=, if present, must be 1. template inline void DoTotalReduction(const Descriptor &x, int dim, const Descriptor *mask, ACCUMULATOR &accumulator, const char *intrinsic, @@ -122,8 +122,7 @@ template inline void ReduceDimToScalar(const Descriptor &x, int zeroBasedDim, - SubscriptValue subscripts[], TYPE *result) { - ACCUMULATOR accumulator{x}; + SubscriptValue subscripts[], TYPE *result, ACCUMULATOR &accumulator) { SubscriptValue xAt[maxRank]; GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts); const auto &dim{x.GetDimension(zeroBasedDim)}; @@ -143,8 +142,8 @@ template inline void ReduceDimMaskToScalar(const Descriptor &x, int zeroBasedDim, - SubscriptValue subscripts[], const Descriptor &mask, TYPE *result) { - ACCUMULATOR accumulator{x}; + SubscriptValue subscripts[], const Descriptor &mask, TYPE *result, + ACCUMULATOR &accumulator) { SubscriptValue xAt[maxRank], maskAt[maxRank]; GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts); GetExpandedSubscripts(maskAt, mask, zeroBasedDim, subscripts); @@ -201,7 +200,8 @@ template inline void PartialReduction(Descriptor &result, const Descriptor &x, int dim, - const Descriptor *mask, Terminator &terminator, const char *intrinsic) { + const Descriptor *mask, Terminator &terminator, const char *intrinsic, + ACCUMULATOR &accumulator) { CreatePartialReductionResult( result, x, dim, terminator, intrinsic, TypeCode{CAT, KIND}); SubscriptValue at[maxRank]; @@ -213,13 +213,14 @@ SubscriptValue maskAt[maxRank]; // contents unused if (mask->rank() > 0) { for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) { + accumulator.Reinitialize(); ReduceDimMaskToScalar( - x, dim - 1, at, *mask, result.Element(at)); + x, dim - 1, at, *mask, result.Element(at), accumulator); } return; } else if (!IsLogicalElementTrue(*mask, maskAt)) { // scalar MASK=.FALSE. - ACCUMULATOR accumulator{x}; + accumulator.Reinitialize(); for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) { accumulator.GetResult(result.Element(at)); } @@ -228,11 +229,54 @@ } // No MASK= or scalar MASK=.TRUE. for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) { + accumulator.Reinitialize(); ReduceDimToScalar( - x, dim - 1, at, result.Element(at)); + x, dim - 1, at, result.Element(at), accumulator); } } +template