1 //===-- runtime/product.cpp -----------------------------------------------===//
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 "reduction-templates.h"
12 #include "flang/Runtime/float128.h"
13 #include "flang/Runtime/reduction.h"
14 #include <cfloat>
15 #include <cinttypes>
16 #include <complex>
17
18 namespace Fortran::runtime {
19 template <typename INTERMEDIATE> class NonComplexProductAccumulator {
20 public:
NonComplexProductAccumulator(const Descriptor & array)21 explicit NonComplexProductAccumulator(const Descriptor &array)
22 : array_{array} {}
Reinitialize()23 void Reinitialize() { product_ = 1; }
GetResult(A * p,int=-1) const24 template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
25 *p = static_cast<A>(product_);
26 }
AccumulateAt(const SubscriptValue at[])27 template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
28 product_ *= *array_.Element<A>(at);
29 return product_ != 0;
30 }
31
32 private:
33 const Descriptor &array_;
34 INTERMEDIATE product_{1};
35 };
36
37 template <typename PART> class ComplexProductAccumulator {
38 public:
ComplexProductAccumulator(const Descriptor & array)39 explicit ComplexProductAccumulator(const Descriptor &array) : array_{array} {}
Reinitialize()40 void Reinitialize() { product_ = std::complex<PART>{1, 0}; }
GetResult(A * p,int=-1) const41 template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
42 using ResultPart = typename A::value_type;
43 *p = {static_cast<ResultPart>(product_.real()),
44 static_cast<ResultPart>(product_.imag())};
45 }
AccumulateAt(const SubscriptValue at[])46 template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
47 product_ *= *array_.Element<A>(at);
48 return true;
49 }
50
51 private:
52 const Descriptor &array_;
53 std::complex<PART> product_{1, 0};
54 };
55
56 extern "C" {
RTNAME(ProductInteger1)57 CppTypeFor<TypeCategory::Integer, 1> RTNAME(ProductInteger1)(
58 const Descriptor &x, const char *source, int line, int dim,
59 const Descriptor *mask) {
60 return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
61 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
62 "PRODUCT");
63 }
RTNAME(ProductInteger2)64 CppTypeFor<TypeCategory::Integer, 2> RTNAME(ProductInteger2)(
65 const Descriptor &x, const char *source, int line, int dim,
66 const Descriptor *mask) {
67 return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
68 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
69 "PRODUCT");
70 }
RTNAME(ProductInteger4)71 CppTypeFor<TypeCategory::Integer, 4> RTNAME(ProductInteger4)(
72 const Descriptor &x, const char *source, int line, int dim,
73 const Descriptor *mask) {
74 return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
75 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
76 "PRODUCT");
77 }
RTNAME(ProductInteger8)78 CppTypeFor<TypeCategory::Integer, 8> RTNAME(ProductInteger8)(
79 const Descriptor &x, const char *source, int line, int dim,
80 const Descriptor *mask) {
81 return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
82 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
83 "PRODUCT");
84 }
85 #ifdef __SIZEOF_INT128__
RTNAME(ProductInteger16)86 CppTypeFor<TypeCategory::Integer, 16> RTNAME(ProductInteger16)(
87 const Descriptor &x, const char *source, int line, int dim,
88 const Descriptor *mask) {
89 return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
90 mask,
91 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
92 "PRODUCT");
93 }
94 #endif
95
96 // TODO: real/complex(2 & 3)
RTNAME(ProductReal4)97 CppTypeFor<TypeCategory::Real, 4> RTNAME(ProductReal4)(const Descriptor &x,
98 const char *source, int line, int dim, const Descriptor *mask) {
99 return GetTotalReduction<TypeCategory::Real, 4>(x, source, line, dim, mask,
100 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
101 "PRODUCT");
102 }
RTNAME(ProductReal8)103 CppTypeFor<TypeCategory::Real, 8> RTNAME(ProductReal8)(const Descriptor &x,
104 const char *source, int line, int dim, const Descriptor *mask) {
105 return GetTotalReduction<TypeCategory::Real, 8>(x, source, line, dim, mask,
106 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
107 "PRODUCT");
108 }
109 #if LDBL_MANT_DIG == 64
RTNAME(ProductReal10)110 CppTypeFor<TypeCategory::Real, 10> RTNAME(ProductReal10)(const Descriptor &x,
111 const char *source, int line, int dim, const Descriptor *mask) {
112 return GetTotalReduction<TypeCategory::Real, 10>(x, source, line, dim, mask,
113 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
114 "PRODUCT");
115 }
116 #elif LDBL_MANT_DIG == 113
RTNAME(ProductReal16)117 CppTypeFor<TypeCategory::Real, 16> RTNAME(ProductReal16)(const Descriptor &x,
118 const char *source, int line, int dim, const Descriptor *mask) {
119 return GetTotalReduction<TypeCategory::Real, 16>(x, source, line, dim, mask,
120 NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
121 "PRODUCT");
122 }
123 #endif
124
RTNAME(CppProductComplex4)125 void RTNAME(CppProductComplex4)(CppTypeFor<TypeCategory::Complex, 4> &result,
126 const Descriptor &x, const char *source, int line, int dim,
127 const Descriptor *mask) {
128 result = GetTotalReduction<TypeCategory::Complex, 4>(x, source, line, dim,
129 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
130 "PRODUCT");
131 }
RTNAME(CppProductComplex8)132 void RTNAME(CppProductComplex8)(CppTypeFor<TypeCategory::Complex, 8> &result,
133 const Descriptor &x, const char *source, int line, int dim,
134 const Descriptor *mask) {
135 result = GetTotalReduction<TypeCategory::Complex, 8>(x, source, line, dim,
136 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
137 "PRODUCT");
138 }
139 #if LDBL_MANT_DIG == 64
RTNAME(CppProductComplex10)140 void RTNAME(CppProductComplex10)(CppTypeFor<TypeCategory::Complex, 10> &result,
141 const Descriptor &x, const char *source, int line, int dim,
142 const Descriptor *mask) {
143 result = GetTotalReduction<TypeCategory::Complex, 10>(x, source, line, dim,
144 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
145 "PRODUCT");
146 }
147 #elif LDBL_MANT_DIG == 113
RTNAME(CppProductComplex16)148 void RTNAME(CppProductComplex16)(CppTypeFor<TypeCategory::Complex, 16> &result,
149 const Descriptor &x, const char *source, int line, int dim,
150 const Descriptor *mask) {
151 result = GetTotalReduction<TypeCategory::Complex, 16>(x, source, line, dim,
152 mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
153 "PRODUCT");
154 }
155 #endif
156
RTNAME(ProductDim)157 void RTNAME(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
158 const char *source, int line, const Descriptor *mask) {
159 TypedPartialNumericReduction<NonComplexProductAccumulator,
160 NonComplexProductAccumulator, ComplexProductAccumulator>(
161 result, x, dim, source, line, mask, "PRODUCT");
162 }
163 } // extern "C"
164 } // namespace Fortran::runtime
165