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:
21   explicit NonComplexProductAccumulator(const Descriptor &array)
22       : array_{array} {}
23   void Reinitialize() { product_ = 1; }
24   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
25     *p = static_cast<A>(product_);
26   }
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:
39   explicit ComplexProductAccumulator(const Descriptor &array) : array_{array} {}
40   void Reinitialize() { product_ = std::complex<PART>{1, 0}; }
41   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   }
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" {
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 }
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 }
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 }
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__
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)
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 }
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
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
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 
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 }
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
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
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 
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