1//===-- lib/runtime/product.cpp ---------------------------------*- C++ -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9// Implements PRODUCT for all required operand types and shapes.
10
11#include "flang-rt/runtime/reduction-templates.h"
12#include "flang/Common/float128.h"
13#include "flang/Runtime/reduction.h"
14#include <cfloat>
15#include <cinttypes>
16#include <complex>
17
18namespace Fortran::runtime {
19template <typename INTERMEDIATE> class NonComplexProductAccumulator {
20public:
21 explicit RT_API_ATTRS NonComplexProductAccumulator(const Descriptor &array)
22 : array_{array} {}
23 RT_API_ATTRS void Reinitialize() { product_ = 1; }
24 template <typename A>
25 RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
26 *p = static_cast<A>(product_);
27 }
28 template <typename A>
29 RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
30 product_ *= *array_.Element<A>(at);
31 return product_ != 0;
32 }
33
34private:
35 const Descriptor &array_;
36 INTERMEDIATE product_{1};
37};
38
39template <typename PART> class ComplexProductAccumulator {
40public:
41 explicit RT_API_ATTRS ComplexProductAccumulator(const Descriptor &array)
42 : array_{array} {}
43 RT_API_ATTRS void Reinitialize() { product_ = rtcmplx::complex<PART>{1, 0}; }
44 template <typename A>
45 RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
46 using ResultPart = typename A::value_type;
47 *p = {static_cast<ResultPart>(product_.real()),
48 static_cast<ResultPart>(product_.imag())};
49 }
50 template <typename A>
51 RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
52 product_ *= *array_.Element<A>(at);
53 return true;
54 }
55
56private:
57 const Descriptor &array_;
58 rtcmplx::complex<PART> product_{1, 0};
59};
60
61extern "C" {
62RT_EXT_API_GROUP_BEGIN
63
64CppTypeFor<TypeCategory::Integer, 1> RTDEF(ProductInteger1)(const Descriptor &x,
65 const char *source, int line, int dim, const Descriptor *mask) {
66 return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
67 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
68 "PRODUCT");
69}
70CppTypeFor<TypeCategory::Integer, 2> RTDEF(ProductInteger2)(const Descriptor &x,
71 const char *source, int line, int dim, const Descriptor *mask) {
72 return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
73 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
74 "PRODUCT");
75}
76CppTypeFor<TypeCategory::Integer, 4> RTDEF(ProductInteger4)(const Descriptor &x,
77 const char *source, int line, int dim, const Descriptor *mask) {
78 return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
79 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
80 "PRODUCT");
81}
82CppTypeFor<TypeCategory::Integer, 8> RTDEF(ProductInteger8)(const Descriptor &x,
83 const char *source, int line, int dim, const Descriptor *mask) {
84 return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
85 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
86 "PRODUCT");
87}
88#ifdef __SIZEOF_INT128__
89CppTypeFor<TypeCategory::Integer, 16> RTDEF(ProductInteger16)(
90 const Descriptor &x, const char *source, int line, int dim,
91 const Descriptor *mask) {
92 return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
93 mask,
94 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
95 "PRODUCT");
96}
97#endif
98
99CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(ProductUnsigned1)(
100 const Descriptor &x, const char *source, int line, int dim,
101 const Descriptor *mask) {
102 return GetTotalReduction<TypeCategory::Unsigned, 1>(x, source, line, dim,
103 mask,
104 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
105 "PRODUCT");
106}
107CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(ProductUnsigned2)(
108 const Descriptor &x, const char *source, int line, int dim,
109 const Descriptor *mask) {
110 return GetTotalReduction<TypeCategory::Unsigned, 2>(x, source, line, dim,
111 mask,
112 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
113 "PRODUCT");
114}
115CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(ProductUnsigned4)(
116 const Descriptor &x, const char *source, int line, int dim,
117 const Descriptor *mask) {
118 return GetTotalReduction<TypeCategory::Unsigned, 4>(x, source, line, dim,
119 mask,
120 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
121 "PRODUCT");
122}
123CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(ProductUnsigned8)(
124 const Descriptor &x, const char *source, int line, int dim,
125 const Descriptor *mask) {
126 return GetTotalReduction<TypeCategory::Unsigned, 8>(x, source, line, dim,
127 mask,
128 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 8>>{x},
129 "PRODUCT");
130}
131#ifdef __SIZEOF_INT128__
132CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(ProductUnsigned16)(
133 const Descriptor &x, const char *source, int line, int dim,
134 const Descriptor *mask) {
135 return GetTotalReduction<TypeCategory::Unsigned, 16>(x, source, line, dim,
136 mask,
137 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 16>>{x},
138 "PRODUCT");
139}
140#endif
141
142// TODO: real/complex(2 & 3)
143CppTypeFor<TypeCategory::Real, 4> RTDEF(ProductReal4)(const Descriptor &x,
144 const char *source, int line, int dim, const Descriptor *mask) {
145 return GetTotalReduction<TypeCategory::Real, 4>(x, source, line, dim, mask,
146 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 4>>{x},
147 "PRODUCT");
148}
149CppTypeFor<TypeCategory::Real, 8> RTDEF(ProductReal8)(const Descriptor &x,
150 const char *source, int line, int dim, const Descriptor *mask) {
151 return GetTotalReduction<TypeCategory::Real, 8>(x, source, line, dim, mask,
152 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
153 "PRODUCT");
154}
155#if HAS_FLOAT80
156CppTypeFor<TypeCategory::Real, 10> RTDEF(ProductReal10)(const Descriptor &x,
157 const char *source, int line, int dim, const Descriptor *mask) {
158 return GetTotalReduction<TypeCategory::Real, 10>(x, source, line, dim, mask,
159 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
160 "PRODUCT");
161}
162#endif
163#if HAS_LDBL128 || HAS_FLOAT128
164CppTypeFor<TypeCategory::Real, 16> RTDEF(ProductReal16)(const Descriptor &x,
165 const char *source, int line, int dim, const Descriptor *mask) {
166 return GetTotalReduction<TypeCategory::Real, 16>(x, source, line, dim, mask,
167 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
168 "PRODUCT");
169}
170#endif
171
172void RTDEF(CppProductComplex4)(CppTypeFor<TypeCategory::Complex, 4> &result,
173 const Descriptor &x, const char *source, int line, int dim,
174 const Descriptor *mask) {
175 result = GetTotalReduction<TypeCategory::Complex, 4>(x, source, line, dim,
176 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 4>>{x},
177 "PRODUCT");
178}
179void RTDEF(CppProductComplex8)(CppTypeFor<TypeCategory::Complex, 8> &result,
180 const Descriptor &x, const char *source, int line, int dim,
181 const Descriptor *mask) {
182 result = GetTotalReduction<TypeCategory::Complex, 8>(x, source, line, dim,
183 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
184 "PRODUCT");
185}
186#if HAS_FLOAT80
187void RTDEF(CppProductComplex10)(CppTypeFor<TypeCategory::Complex, 10> &result,
188 const Descriptor &x, const char *source, int line, int dim,
189 const Descriptor *mask) {
190 result = GetTotalReduction<TypeCategory::Complex, 10>(x, source, line, dim,
191 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
192 "PRODUCT");
193}
194#endif
195#if HAS_LDBL128 || HAS_FLOAT128
196void RTDEF(CppProductComplex16)(CppTypeFor<TypeCategory::Complex, 16> &result,
197 const Descriptor &x, const char *source, int line, int dim,
198 const Descriptor *mask) {
199 result = GetTotalReduction<TypeCategory::Complex, 16>(x, source, line, dim,
200 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
201 "PRODUCT");
202}
203#endif
204
205void RTDEF(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
206 const char *source, int line, const Descriptor *mask) {
207 TypedPartialNumericReduction<NonComplexProductAccumulator,
208 NonComplexProductAccumulator, ComplexProductAccumulator,
209 /*MIN_REAL_KIND=*/4>(result, x, dim, source, line, mask, "PRODUCT");
210}
211
212RT_EXT_API_GROUP_END
213} // extern "C"
214} // namespace Fortran::runtime
215

source code of flang-rt/lib/runtime/product.cpp