Bug Summary

File:build/source/flang/runtime/findloc.cpp
Warning:line 102, column 29
The left operand of '-' is a garbage value

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-pc-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name findloc.cpp -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model pic -pic-level 2 -mframe-pointer=none -relaxed-aliasing -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -ffunction-sections -fdata-sections -fcoverage-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -resource-dir /usr/lib/llvm-17/lib/clang/17 -isystem /build/source/llvm/../mlir/include -isystem tools/mlir/include -isystem tools/clang/include -isystem /build/source/llvm/../clang/include -D FLANG_INCLUDE_TESTS=1 -D FLANG_LITTLE_ENDIAN=1 -D FLANG_VENDOR="Debian " -D _DEBUG -D _GLIBCXX_ASSERTIONS -D _GNU_SOURCE -D _LIBCPP_ENABLE_ASSERTIONS -D __STDC_CONSTANT_MACROS -D __STDC_FORMAT_MACROS -D __STDC_LIMIT_MACROS -I tools/flang/runtime -I /build/source/flang/runtime -I /build/source/flang/include -I tools/flang/include -I include -I /build/source/llvm/include -D _FORTIFY_SOURCE=2 -D NDEBUG -U _GLIBCXX_ASSERTIONS -U _LIBCPP_ENABLE_ASSERTIONS -U NDEBUG -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/x86_64-linux-gnu/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10/backward -internal-isystem /usr/lib/llvm-17/lib/clang/17/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -fmacro-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fmacro-prefix-map=/build/source/= -fcoverage-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fcoverage-prefix-map=/build/source/= -source-date-epoch 1683717183 -O2 -Wno-unused-command-line-argument -Wno-unused-parameter -Wwrite-strings -Wno-missing-field-initializers -Wno-long-long -Wno-maybe-uninitialized -Wno-class-memaccess -Wno-redundant-move -Wno-pessimizing-move -Wno-noexcept-type -Wno-comment -Wno-misleading-indentation -Wno-deprecated-copy -Wno-ctad-maybe-unsupported -std=c++17 -fdeprecated-macro -fdebug-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/= -ferror-limit 19 -fvisibility-inlines-hidden -stack-protector 2 -fgnuc-version=4.2.1 -fcolor-diagnostics -vectorize-loops -vectorize-slp -analyzer-output=html -analyzer-config stable-report-filename=true -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2023-05-10-133810-16478-1 -x c++ /build/source/flang/runtime/findloc.cpp

/build/source/flang/runtime/findloc.cpp

1//===-- runtime/findloc.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 FINDLOC for all required operand types and shapes and result
10// integer kinds.
11
12#include "reduction-templates.h"
13#include "flang/Runtime/character.h"
14#include "flang/Runtime/reduction.h"
15#include <cinttypes>
16#include <complex>
17
18namespace Fortran::runtime {
19
20template <TypeCategory CAT1, int KIND1, TypeCategory CAT2, int KIND2>
21struct Equality {
22 using Type1 = CppTypeFor<CAT1, KIND1>;
23 using Type2 = CppTypeFor<CAT2, KIND2>;
24 bool operator()(const Descriptor &array, const SubscriptValue at[],
25 const Descriptor &target) const {
26 return *array.Element<Type1>(at) == *target.OffsetElement<Type2>();
27 }
28};
29
30template <int KIND1, int KIND2>
31struct Equality<TypeCategory::Complex, KIND1, TypeCategory::Complex, KIND2> {
32 using Type1 = CppTypeFor<TypeCategory::Complex, KIND1>;
33 using Type2 = CppTypeFor<TypeCategory::Complex, KIND2>;
34 bool operator()(const Descriptor &array, const SubscriptValue at[],
35 const Descriptor &target) const {
36 const Type1 &xz{*array.Element<Type1>(at)};
37 const Type2 &tz{*target.OffsetElement<Type2>()};
38 return xz.real() == tz.real() && xz.imag() == tz.imag();
39 }
40};
41
42template <int KIND1, TypeCategory CAT2, int KIND2>
43struct Equality<TypeCategory::Complex, KIND1, CAT2, KIND2> {
44 using Type1 = CppTypeFor<TypeCategory::Complex, KIND1>;
45 using Type2 = CppTypeFor<CAT2, KIND2>;
46 bool operator()(const Descriptor &array, const SubscriptValue at[],
47 const Descriptor &target) const {
48 const Type1 &z{*array.Element<Type1>(at)};
49 return z.imag() == 0 && z.real() == *target.OffsetElement<Type2>();
50 }
51};
52
53template <TypeCategory CAT1, int KIND1, int KIND2>
54struct Equality<CAT1, KIND1, TypeCategory::Complex, KIND2> {
55 using Type1 = CppTypeFor<CAT1, KIND1>;
56 using Type2 = CppTypeFor<TypeCategory::Complex, KIND2>;
57 bool operator()(const Descriptor &array, const SubscriptValue at[],
58 const Descriptor &target) const {
59 const Type2 &z{*target.OffsetElement<Type2>()};
60 return *array.Element<Type1>(at) == z.real() && z.imag() == 0;
61 }
62};
63
64template <int KIND> struct CharacterEquality {
65 using Type = CppTypeFor<TypeCategory::Character, KIND>;
66 bool operator()(const Descriptor &array, const SubscriptValue at[],
67 const Descriptor &target) const {
68 return CharacterScalarCompare<Type>(array.Element<Type>(at),
69 target.OffsetElement<Type>(),
70 array.ElementBytes() / static_cast<unsigned>(KIND),
71 target.ElementBytes() / static_cast<unsigned>(KIND)) == 0;
72 }
73};
74
75struct LogicalEquivalence {
76 bool operator()(const Descriptor &array, const SubscriptValue at[],
77 const Descriptor &target) const {
78 return IsLogicalElementTrue(array, at) ==
79 IsLogicalElementTrue(target, at /*ignored*/);
80 }
81};
82
83template <typename EQUALITY> class LocationAccumulator {
84public:
85 LocationAccumulator(
86 const Descriptor &array, const Descriptor &target, bool back)
87 : array_{array}, target_{target}, back_{back} {
88 Reinitialize();
89 }
90 void Reinitialize() {
91 // per standard: result indices are all zero if no data
92 for (int j{0}; j < rank_; ++j) {
93 location_[j] = 0;
94 }
95 }
96 template <typename A> void GetResult(A *p, int zeroBasedDim = -1) {
97 if (zeroBasedDim
21.1
'zeroBasedDim' is < 0
21.1
'zeroBasedDim' is < 0
21.1
'zeroBasedDim' is < 0
>= 0) {
22
Taking false branch
98 *p = location_[zeroBasedDim] -
99 array_.GetDimension(zeroBasedDim).LowerBound() + 1;
100 } else {
101 for (int j{0}; j < rank_; ++j) {
23
'j' initialized to 0
24
Loop condition is true. Entering loop body
102 p[j] = location_[j] - array_.GetDimension(j).LowerBound() + 1;
25
The left operand of '-' is a garbage value
103 }
104 }
105 }
106 template <typename IGNORED> bool AccumulateAt(const SubscriptValue at[]) {
107 if (equality_(array_, at, target_)) {
108 for (int j{0}; j < rank_; ++j) {
109 location_[j] = at[j];
110 }
111 return back_;
112 } else {
113 return true;
114 }
115 }
116
117private:
118 const Descriptor &array_;
119 const Descriptor &target_;
120 const bool back_{false};
121 const int rank_{array_.rank()};
122 SubscriptValue location_[maxRank];
123 const EQUALITY equality_{};
124};
125
126template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
127struct TotalNumericFindlocHelper {
128 template <int TARGET_KIND> struct Functor {
129 void operator()(Descriptor &result, const Descriptor &x,
130 const Descriptor &target, int kind, int dim, const Descriptor *mask,
131 bool back, Terminator &terminator) const {
132 using Eq = Equality<XCAT, XKIND, TARGET_CAT, TARGET_KIND>;
133 using Accumulator = LocationAccumulator<Eq>;
134 Accumulator accumulator{x, target, back};
135 DoTotalReduction<void>(x, dim, mask, accumulator, "FINDLOC", terminator);
136 ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor,
137 void>(kind, terminator, accumulator, result);
138 }
139 };
140};
141
142template <TypeCategory CAT,
143 template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
144 class HELPER>
145struct NumericFindlocHelper {
146 template <int KIND> struct Functor {
147 void operator()(TypeCategory targetCat, int targetKind, Descriptor &result,
148 const Descriptor &x, const Descriptor &target, int kind, int dim,
149 const Descriptor *mask, bool back, Terminator &terminator) const {
150 switch (targetCat) {
151 case TypeCategory::Integer:
152 ApplyIntegerKind<
153 HELPER<CAT, KIND, TypeCategory::Integer>::template Functor, void>(
154 targetKind, terminator, result, x, target, kind, dim, mask, back,
155 terminator);
156 break;
157 case TypeCategory::Real:
158 ApplyFloatingPointKind<
159 HELPER<CAT, KIND, TypeCategory::Real>::template Functor, void>(
160 targetKind, terminator, result, x, target, kind, dim, mask, back,
161 terminator);
162 break;
163 case TypeCategory::Complex:
164 ApplyFloatingPointKind<
165 HELPER<CAT, KIND, TypeCategory::Complex>::template Functor, void>(
166 targetKind, terminator, result, x, target, kind, dim, mask, back,
167 terminator);
168 break;
169 default:
170 terminator.Crash(
171 "FINDLOC: bad target category %d for array category %d",
172 static_cast<int>(targetCat), static_cast<int>(CAT));
173 }
174 }
175 };
176};
177
178template <int KIND> struct CharacterFindlocHelper {
179 void operator()(Descriptor &result, const Descriptor &x,
180 const Descriptor &target, int kind, const Descriptor *mask, bool back,
181 Terminator &terminator) {
182 using Accumulator = LocationAccumulator<CharacterEquality<KIND>>;
183 Accumulator accumulator{x, target, back};
184 DoTotalReduction<void>(x, 0, mask, accumulator, "FINDLOC", terminator);
185 ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor, void>(
186 kind, terminator, accumulator, result);
187 }
188};
189
190static void LogicalFindlocHelper(Descriptor &result, const Descriptor &x,
191 const Descriptor &target, int kind, const Descriptor *mask, bool back,
192 Terminator &terminator) {
193 using Accumulator = LocationAccumulator<LogicalEquivalence>;
194 Accumulator accumulator{x, target, back};
195 DoTotalReduction<void>(x, 0, mask, accumulator, "FINDLOC", terminator);
196 ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor, void>(
197 kind, terminator, accumulator, result);
198}
199
200extern "C" {
201void RTNAME(Findloc)_FortranAFindloc(Descriptor &result, const Descriptor &x,
202 const Descriptor &target, int kind, const char *source, int line,
203 const Descriptor *mask, bool back) {
204 int rank{x.rank()};
205 SubscriptValue extent[1]{rank};
206 result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent,
207 CFI_attribute_allocatable2);
208 result.GetDimension(0).SetBounds(1, extent[0]);
209 Terminator terminator{source, line};
210 if (int stat{result.Allocate()}) {
211 terminator.Crash(
212 "FINDLOC: could not allocate memory for result; STAT=%d", stat);
213 }
214 CheckIntegerKind(terminator, kind, "FINDLOC");
215 auto xType{x.type().GetCategoryAndKind()};
216 auto targetType{target.type().GetCategoryAndKind()};
217 RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value())if (xType.has_value() && targetType.has_value()) ; else
(terminator).CheckFailed("xType.has_value() && targetType.has_value()"
, "flang/runtime/findloc.cpp", 217)
;
218 switch (xType->first) {
219 case TypeCategory::Integer:
220 ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Integer,
221 TotalNumericFindlocHelper>::template Functor,
222 void>(xType->second, terminator, targetType->first, targetType->second,
223 result, x, target, kind, 0, mask, back, terminator);
224 break;
225 case TypeCategory::Real:
226 ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real,
227 TotalNumericFindlocHelper>::template Functor,
228 void>(xType->second, terminator, targetType->first, targetType->second,
229 result, x, target, kind, 0, mask, back, terminator);
230 break;
231 case TypeCategory::Complex:
232 ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Complex,
233 TotalNumericFindlocHelper>::template Functor,
234 void>(xType->second, terminator, targetType->first, targetType->second,
235 result, x, target, kind, 0, mask, back, terminator);
236 break;
237 case TypeCategory::Character:
238 RUNTIME_CHECK(terminator,if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 240)
239 targetType->first == TypeCategory::Character &&if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 240)
240 targetType->second == xType->second)if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 240)
;
241 ApplyCharacterKind<CharacterFindlocHelper, void>(xType->second, terminator,
242 result, x, target, kind, mask, back, terminator);
243 break;
244 case TypeCategory::Logical:
245 RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical)if (targetType->first == TypeCategory::Logical) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Logical"
, "flang/runtime/findloc.cpp", 245)
;
246 LogicalFindlocHelper(result, x, target, kind, mask, back, terminator);
247 break;
248 default:
249 terminator.Crash(
250 "FINDLOC: bad data type code (%d) for array", x.type().raw());
251 }
252}
253} // extern "C"
254
255// FINDLOC with DIM=
256
257template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
258struct PartialNumericFindlocHelper {
259 template <int TARGET_KIND> struct Functor {
260 void operator()(Descriptor &result, const Descriptor &x,
261 const Descriptor &target, int kind, int dim, const Descriptor *mask,
262 bool back, Terminator &terminator) const {
263 using Eq = Equality<XCAT, XKIND, TARGET_CAT, TARGET_KIND>;
264 using Accumulator = LocationAccumulator<Eq>;
265 Accumulator accumulator{x, target, back};
266 ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor,
267 void>(kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
268 accumulator);
269 }
270 };
271};
272
273template <int KIND> struct PartialCharacterFindlocHelper {
274 void operator()(Descriptor &result, const Descriptor &x,
275 const Descriptor &target, int kind, int dim, const Descriptor *mask,
276 bool back, Terminator &terminator) {
277 using Accumulator = LocationAccumulator<CharacterEquality<KIND>>;
278 Accumulator accumulator{x, target, back};
279 ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor,
280 void>(kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
281 accumulator);
282 }
283};
284
285static void PartialLogicalFindlocHelper(Descriptor &result, const Descriptor &x,
286 const Descriptor &target, int kind, int dim, const Descriptor *mask,
287 bool back, Terminator &terminator) {
288 using Accumulator = LocationAccumulator<LogicalEquivalence>;
289 Accumulator accumulator{x, target, back};
290 ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor, void>(
8
Calling 'ApplyIntegerKind<Fortran::runtime::PartialLocationHelper<Fortran::runtime::LocationAccumulator<Fortran::runtime::LogicalEquivalence>>::Functor, void, Fortran::runtime::Descriptor &, const Fortran::runtime::Descriptor &, int &, const Fortran::runtime::Descriptor *&, Fortran::runtime::Terminator &, const char (&)[8], Fortran::runtime::LocationAccumulator<Fortran::runtime::LogicalEquivalence> &>'
291 kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
292 accumulator);
293}
294
295extern "C" {
296void RTNAME(FindlocDim)_FortranAFindlocDim(Descriptor &result, const Descriptor &x,
297 const Descriptor &target, int kind, int dim, const char *source, int line,
298 const Descriptor *mask, bool back) {
299 Terminator terminator{source, line};
300 CheckIntegerKind(terminator, kind, "FINDLOC");
301 auto xType{x.type().GetCategoryAndKind()};
302 auto targetType{target.type().GetCategoryAndKind()};
303 RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value())if (xType.has_value() && targetType.has_value()) ; else
(terminator).CheckFailed("xType.has_value() && targetType.has_value()"
, "flang/runtime/findloc.cpp", 303)
;
1
Assuming the condition is true
2
Assuming the condition is true
3
Taking true branch
304 switch (xType->first) {
4
Control jumps to 'case Logical:' at line 330
305 case TypeCategory::Integer:
306 ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Integer,
307 PartialNumericFindlocHelper>::template Functor,
308 void>(xType->second, terminator, targetType->first, targetType->second,
309 result, x, target, kind, dim, mask, back, terminator);
310 break;
311 case TypeCategory::Real:
312 ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real,
313 PartialNumericFindlocHelper>::template Functor,
314 void>(xType->second, terminator, targetType->first, targetType->second,
315 result, x, target, kind, dim, mask, back, terminator);
316 break;
317 case TypeCategory::Complex:
318 ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Complex,
319 PartialNumericFindlocHelper>::template Functor,
320 void>(xType->second, terminator, targetType->first, targetType->second,
321 result, x, target, kind, dim, mask, back, terminator);
322 break;
323 case TypeCategory::Character:
324 RUNTIME_CHECK(terminator,if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 326)
325 targetType->first == TypeCategory::Character &&if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 326)
326 targetType->second == xType->second)if (targetType->first == TypeCategory::Character &&
targetType->second == xType->second) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Character && targetType->second == xType->second"
, "flang/runtime/findloc.cpp", 326)
;
327 ApplyCharacterKind<PartialCharacterFindlocHelper, void>(xType->second,
328 terminator, result, x, target, kind, dim, mask, back, terminator);
329 break;
330 case TypeCategory::Logical:
331 RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical)if (targetType->first == TypeCategory::Logical) ; else (terminator
).CheckFailed("targetType->first == TypeCategory::Logical"
, "flang/runtime/findloc.cpp", 331)
;
5
Assuming field 'first' is equal to Logical
6
Taking true branch
332 PartialLogicalFindlocHelper(
7
Calling 'PartialLogicalFindlocHelper'
333 result, x, target, kind, dim, mask, back, terminator);
334 break;
335 default:
336 terminator.Crash(
337 "FINDLOC: bad data type code (%d) for array", x.type().raw());
338 }
339}
340} // extern "C"
341} // namespace Fortran::runtime

/build/source/flang/runtime/tools.h

1//===-- runtime/tools.h -----------------------------------------*- 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#ifndef FORTRAN_RUNTIME_TOOLS_H_
10#define FORTRAN_RUNTIME_TOOLS_H_
11
12#include "terminator.h"
13#include "flang/Runtime/cpp-type.h"
14#include "flang/Runtime/descriptor.h"
15#include "flang/Runtime/memory.h"
16#include <cstring>
17#include <functional>
18#include <map>
19#include <type_traits>
20
21namespace Fortran::runtime {
22
23class Terminator;
24
25std::size_t TrimTrailingSpaces(const char *, std::size_t);
26
27OwningPtr<char> SaveDefaultCharacter(
28 const char *, std::size_t, const Terminator &);
29
30// For validating and recognizing default CHARACTER values in a
31// case-insensitive manner. Returns the zero-based index into the
32// null-terminated array of upper-case possibilities when the value is valid,
33// or -1 when it has no match.
34int IdentifyValue(
35 const char *value, std::size_t length, const char *possibilities[]);
36
37// Truncates or pads as necessary
38void ToFortranDefaultCharacter(
39 char *to, std::size_t toLength, const char *from);
40
41// Utility for dealing with elemental LOGICAL arguments
42inline bool IsLogicalElementTrue(
43 const Descriptor &logical, const SubscriptValue at[]) {
44 // A LOGICAL value is false if and only if all of its bytes are zero.
45 const char *p{logical.Element<char>(at)};
46 for (std::size_t j{logical.ElementBytes()}; j-- > 0; ++p) {
47 if (*p) {
48 return true;
49 }
50 }
51 return false;
52}
53
54// Check array conformability; a scalar 'x' conforms. Crashes on error.
55void CheckConformability(const Descriptor &to, const Descriptor &x,
56 Terminator &, const char *funcName, const char *toName,
57 const char *fromName);
58
59// Helper to store integer value in result[at].
60template <int KIND> struct StoreIntegerAt {
61 void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
62 std::int64_t value) const {
63 *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
64 Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
65 }
66};
67
68// Validate a KIND= argument
69void CheckIntegerKind(Terminator &, int kind, const char *intrinsic);
70
71template <typename TO, typename FROM>
72inline void PutContiguousConverted(TO *to, FROM *from, std::size_t count) {
73 while (count-- > 0) {
74 *to++ = *from++;
75 }
76}
77
78static inline std::int64_t GetInt64(
79 const char *p, std::size_t bytes, Terminator &terminator) {
80 switch (bytes) {
81 case 1:
82 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
83 case 2:
84 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
85 case 4:
86 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
87 case 8:
88 return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
89 default:
90 terminator.Crash("GetInt64: no case for %zd bytes", bytes);
91 }
92}
93
94template <typename INT>
95inline bool SetInteger(INT &x, int kind, std::int64_t value) {
96 switch (kind) {
97 case 1:
98 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
99 return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x);
100 case 2:
101 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x) = value;
102 return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x);
103 case 4:
104 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x) = value;
105 return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x);
106 case 8:
107 reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
108 return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x);
109 default:
110 return false;
111 }
112}
113
114// Maps intrinsic runtime type category and kind values to the appropriate
115// instantiation of a function object template and calls it with the supplied
116// arguments.
117template <template <TypeCategory, int> class FUNC, typename RESULT,
118 typename... A>
119inline RESULT ApplyType(
120 TypeCategory cat, int kind, Terminator &terminator, A &&...x) {
121 switch (cat) {
122 case TypeCategory::Integer:
123 switch (kind) {
124 case 1:
125 return FUNC<TypeCategory::Integer, 1>{}(std::forward<A>(x)...);
126 case 2:
127 return FUNC<TypeCategory::Integer, 2>{}(std::forward<A>(x)...);
128 case 4:
129 return FUNC<TypeCategory::Integer, 4>{}(std::forward<A>(x)...);
130 case 8:
131 return FUNC<TypeCategory::Integer, 8>{}(std::forward<A>(x)...);
132#ifdef __SIZEOF_INT128__16
133 case 16:
134 return FUNC<TypeCategory::Integer, 16>{}(std::forward<A>(x)...);
135#endif
136 default:
137 terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
138 }
139 case TypeCategory::Real:
140 switch (kind) {
141#if 0 // TODO: REAL(2 & 3)
142 case 2:
143 return FUNC<TypeCategory::Real, 2>{}(std::forward<A>(x)...);
144 case 3:
145 return FUNC<TypeCategory::Real, 3>{}(std::forward<A>(x)...);
146#endif
147 case 4:
148 return FUNC<TypeCategory::Real, 4>{}(std::forward<A>(x)...);
149 case 8:
150 return FUNC<TypeCategory::Real, 8>{}(std::forward<A>(x)...);
151 case 10:
152 if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
153 return FUNC<TypeCategory::Real, 10>{}(std::forward<A>(x)...);
154 }
155 break;
156 case 16:
157 if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
158 return FUNC<TypeCategory::Real, 16>{}(std::forward<A>(x)...);
159 }
160 break;
161 }
162 terminator.Crash("not yet implemented: REAL(KIND=%d)", kind);
163 case TypeCategory::Complex:
164 switch (kind) {
165#if 0 // TODO: COMPLEX(2 & 3)
166 case 2:
167 return FUNC<TypeCategory::Complex, 2>{}(std::forward<A>(x)...);
168 case 3:
169 return FUNC<TypeCategory::Complex, 3>{}(std::forward<A>(x)...);
170#endif
171 case 4:
172 return FUNC<TypeCategory::Complex, 4>{}(std::forward<A>(x)...);
173 case 8:
174 return FUNC<TypeCategory::Complex, 8>{}(std::forward<A>(x)...);
175 case 10:
176 if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
177 return FUNC<TypeCategory::Complex, 10>{}(std::forward<A>(x)...);
178 }
179 break;
180 case 16:
181 if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
182 return FUNC<TypeCategory::Complex, 16>{}(std::forward<A>(x)...);
183 }
184 break;
185 }
186 terminator.Crash("not yet implemented: COMPLEX(KIND=%d)", kind);
187 case TypeCategory::Character:
188 switch (kind) {
189 case 1:
190 return FUNC<TypeCategory::Character, 1>{}(std::forward<A>(x)...);
191 case 2:
192 return FUNC<TypeCategory::Character, 2>{}(std::forward<A>(x)...);
193 case 4:
194 return FUNC<TypeCategory::Character, 4>{}(std::forward<A>(x)...);
195 default:
196 terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
197 }
198 case TypeCategory::Logical:
199 switch (kind) {
200 case 1:
201 return FUNC<TypeCategory::Logical, 1>{}(std::forward<A>(x)...);
202 case 2:
203 return FUNC<TypeCategory::Logical, 2>{}(std::forward<A>(x)...);
204 case 4:
205 return FUNC<TypeCategory::Logical, 4>{}(std::forward<A>(x)...);
206 case 8:
207 return FUNC<TypeCategory::Logical, 8>{}(std::forward<A>(x)...);
208 default:
209 terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
210 }
211 default:
212 terminator.Crash(
213 "not yet implemented: type category(%d)", static_cast<int>(cat));
214 }
215}
216
217// Maps a runtime INTEGER kind value to the appropriate instantiation of
218// a function object template and calls it with the supplied arguments.
219template <template <int KIND> class FUNC, typename RESULT, typename... A>
220inline RESULT ApplyIntegerKind(int kind, Terminator &terminator, A &&...x) {
221 switch (kind) {
9
Control jumps to 'case 16:' at line 231
222 case 1:
223 return FUNC<1>{}(std::forward<A>(x)...);
224 case 2:
225 return FUNC<2>{}(std::forward<A>(x)...);
226 case 4:
227 return FUNC<4>{}(std::forward<A>(x)...);
228 case 8:
229 return FUNC<8>{}(std::forward<A>(x)...);
230#ifdef __SIZEOF_INT128__16
231 case 16:
232 return FUNC<16>{}(std::forward<A>(x)...);
10
Calling 'forward<Fortran::runtime::LocationAccumulator<Fortran::runtime::LogicalEquivalence> &>'
11
Returning from 'forward<Fortran::runtime::LocationAccumulator<Fortran::runtime::LogicalEquivalence> &>'
12
Calling 'Functor::operator()'
233#endif
234 default:
235 terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
236 }
237}
238
239template <template <int KIND> class FUNC, typename RESULT, typename... A>
240inline RESULT ApplyFloatingPointKind(
241 int kind, Terminator &terminator, A &&...x) {
242 switch (kind) {
243#if 0 // TODO: REAL/COMPLEX (2 & 3)
244 case 2:
245 return FUNC<2>{}(std::forward<A>(x)...);
246 case 3:
247 return FUNC<3>{}(std::forward<A>(x)...);
248#endif
249 case 4:
250 return FUNC<4>{}(std::forward<A>(x)...);
251 case 8:
252 return FUNC<8>{}(std::forward<A>(x)...);
253 case 10:
254 if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) {
255 return FUNC<10>{}(std::forward<A>(x)...);
256 }
257 break;
258 case 16:
259 if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
260 return FUNC<16>{}(std::forward<A>(x)...);
261 }
262 break;
263 }
264 terminator.Crash("not yet implemented: REAL/COMPLEX(KIND=%d)", kind);
265}
266
267template <template <int KIND> class FUNC, typename RESULT, typename... A>
268inline RESULT ApplyCharacterKind(int kind, Terminator &terminator, A &&...x) {
269 switch (kind) {
270 case 1:
271 return FUNC<1>{}(std::forward<A>(x)...);
272 case 2:
273 return FUNC<2>{}(std::forward<A>(x)...);
274 case 4:
275 return FUNC<4>{}(std::forward<A>(x)...);
276 default:
277 terminator.Crash("not yet implemented: CHARACTER(KIND=%d)", kind);
278 }
279}
280
281template <template <int KIND> class FUNC, typename RESULT, typename... A>
282inline RESULT ApplyLogicalKind(int kind, Terminator &terminator, A &&...x) {
283 switch (kind) {
284 case 1:
285 return FUNC<1>{}(std::forward<A>(x)...);
286 case 2:
287 return FUNC<2>{}(std::forward<A>(x)...);
288 case 4:
289 return FUNC<4>{}(std::forward<A>(x)...);
290 case 8:
291 return FUNC<8>{}(std::forward<A>(x)...);
292 default:
293 terminator.Crash("not yet implemented: LOGICAL(KIND=%d)", kind);
294 }
295}
296
297// Calculate result type of (X op Y) for *, //, DOT_PRODUCT, &c.
298std::optional<std::pair<TypeCategory, int>> inline constexpr GetResultType(
299 TypeCategory xCat, int xKind, TypeCategory yCat, int yKind) {
300 int maxKind{std::max(xKind, yKind)};
301 switch (xCat) {
302 case TypeCategory::Integer:
303 switch (yCat) {
304 case TypeCategory::Integer:
305 return std::make_pair(TypeCategory::Integer, maxKind);
306 case TypeCategory::Real:
307 case TypeCategory::Complex:
308 return std::make_pair(yCat, yKind);
309 default:
310 break;
311 }
312 break;
313 case TypeCategory::Real:
314 switch (yCat) {
315 case TypeCategory::Integer:
316 return std::make_pair(TypeCategory::Real, xKind);
317 case TypeCategory::Real:
318 case TypeCategory::Complex:
319 return std::make_pair(yCat, maxKind);
320 default:
321 break;
322 }
323 break;
324 case TypeCategory::Complex:
325 switch (yCat) {
326 case TypeCategory::Integer:
327 return std::make_pair(TypeCategory::Complex, xKind);
328 case TypeCategory::Real:
329 case TypeCategory::Complex:
330 return std::make_pair(TypeCategory::Complex, maxKind);
331 default:
332 break;
333 }
334 break;
335 case TypeCategory::Character:
336 if (yCat == TypeCategory::Character) {
337 return std::make_pair(TypeCategory::Character, maxKind);
338 } else {
339 return std::nullopt;
340 }
341 case TypeCategory::Logical:
342 if (yCat == TypeCategory::Logical) {
343 return std::make_pair(TypeCategory::Logical, maxKind);
344 } else {
345 return std::nullopt;
346 }
347 default:
348 break;
349 }
350 return std::nullopt;
351}
352
353// Accumulate floating-point results in (at least) double precision
354template <TypeCategory CAT, int KIND>
355using AccumulationType = CppTypeFor<CAT,
356 CAT == TypeCategory::Real || CAT == TypeCategory::Complex
357 ? std::max(KIND, static_cast<int>(sizeof(double)))
358 : KIND>;
359
360// memchr() for any character type
361template <typename CHAR>
362static inline const CHAR *FindCharacter(
363 const CHAR *data, CHAR ch, std::size_t chars) {
364 const CHAR *end{data + chars};
365 for (const CHAR *p{data}; p < end; ++p) {
366 if (*p == ch) {
367 return p;
368 }
369 }
370 return nullptr;
371}
372
373template <>
374inline const char *FindCharacter(const char *data, char ch, std::size_t chars) {
375 return reinterpret_cast<const char *>(
376 std::memchr(data, static_cast<int>(ch), chars));
377}
378
379} // namespace Fortran::runtime
380#endif // FORTRAN_RUNTIME_TOOLS_H_

/build/source/flang/runtime/reduction-templates.h

1//===-- runtime/reduction-templates.h -------------------------------------===//
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// Generic function templates used by various reduction transformation
10// intrinsic functions (SUM, PRODUCT, &c.)
11//
12// * Partial reductions (i.e., those with DIM= arguments that are not
13// required to be 1 by the rank of the argument) return arrays that
14// are dynamically allocated in a caller-supplied descriptor.
15// * Total reductions (i.e., no DIM= argument) with FINDLOC, MAXLOC, & MINLOC
16// return integer vectors of some kind, not scalars; a caller-supplied
17// descriptor is used
18// * Character-valued reductions (MAXVAL & MINVAL) return arbitrary
19// length results, dynamically allocated in a caller-supplied descriptor
20
21#ifndef FORTRAN_RUNTIME_REDUCTION_TEMPLATES_H_
22#define FORTRAN_RUNTIME_REDUCTION_TEMPLATES_H_
23
24#include "terminator.h"
25#include "tools.h"
26#include "flang/Runtime/cpp-type.h"
27#include "flang/Runtime/descriptor.h"
28
29namespace Fortran::runtime {
30
31// Reductions are implemented with *accumulators*, which are instances of
32// classes that incrementally build up the result (or an element thereof) during
33// a traversal of the unmasked elements of an array. Each accumulator class
34// supports a constructor (which captures a reference to the array), an
35// AccumulateAt() member function that applies supplied subscripts to the
36// array and does something with a scalar element, and a GetResult()
37// member function that copies a final result into its destination.
38
39// Total reduction of the array argument to a scalar (or to a vector in the
40// cases of FINDLOC, MAXLOC, & MINLOC). These are the cases without DIM= or
41// cases where the argument has rank 1 and DIM=, if present, must be 1.
42template <typename TYPE, typename ACCUMULATOR>
43inline void DoTotalReduction(const Descriptor &x, int dim,
44 const Descriptor *mask, ACCUMULATOR &accumulator, const char *intrinsic,
45 Terminator &terminator) {
46 if (dim < 0 || dim > 1) {
47 terminator.Crash("%s: bad DIM=%d for ARRAY argument with rank %d",
48 intrinsic, dim, x.rank());
49 }
50 SubscriptValue xAt[maxRank];
51 x.GetLowerBounds(xAt);
52 if (mask) {
53 CheckConformability(x, *mask, terminator, intrinsic, "ARRAY", "MASK");
54 SubscriptValue maskAt[maxRank];
55 mask->GetLowerBounds(maskAt);
56 if (mask->rank() > 0) {
57 for (auto elements{x.Elements()}; elements--;
58 x.IncrementSubscripts(xAt), mask->IncrementSubscripts(maskAt)) {
59 if (IsLogicalElementTrue(*mask, maskAt)) {
60 if (!accumulator.template AccumulateAt<TYPE>(xAt))
61 break;
62 }
63 }
64 return;
65 } else if (!IsLogicalElementTrue(*mask, maskAt)) {
66 // scalar MASK=.FALSE.: return identity value
67 return;
68 }
69 }
70 // No MASK=, or scalar MASK=.TRUE.
71 for (auto elements{x.Elements()}; elements--; x.IncrementSubscripts(xAt)) {
72 if (!accumulator.template AccumulateAt<TYPE>(xAt)) {
73 break; // cut short, result is known
74 }
75 }
76}
77
78template <TypeCategory CAT, int KIND, typename ACCUMULATOR>
79inline CppTypeFor<CAT, KIND> GetTotalReduction(const Descriptor &x,
80 const char *source, int line, int dim, const Descriptor *mask,
81 ACCUMULATOR &&accumulator, const char *intrinsic) {
82 Terminator terminator{source, line};
83 RUNTIME_CHECK(terminator, TypeCode(CAT, KIND) == x.type())if (TypeCode(CAT, KIND) == x.type()) ; else (terminator).CheckFailed
("TypeCode(CAT, KIND) == x.type()", "flang/runtime/reduction-templates.h"
, 83)
;
84 using CppType = CppTypeFor<CAT, KIND>;
85 DoTotalReduction<CppType>(x, dim, mask, accumulator, intrinsic, terminator);
86 CppType result;
87#ifdef _MSC_VER // work around MSVC spurious error
88 accumulator.GetResult(&result);
89#else
90 accumulator.template GetResult(&result);
91#endif
92 return result;
93}
94
95// For reductions on a dimension, e.g. SUM(array,DIM=2) where the shape
96// of the array is [2,3,5], the shape of the result is [2,5] and
97// result(j,k) = SUM(array(j,:,k)), possibly modified if the array has
98// lower bounds other than one. This utility subroutine creates an
99// array of subscripts [j,_,k] for result subscripts [j,k] so that the
100// elements of array(j,:,k) can be reduced.
101inline void GetExpandedSubscripts(SubscriptValue at[],
102 const Descriptor &descriptor, int zeroBasedDim,
103 const SubscriptValue from[]) {
104 descriptor.GetLowerBounds(at);
105 int rank{descriptor.rank()};
106 int j{0};
107 for (; j < zeroBasedDim; ++j) {
108 at[j] += from[j] - 1 /*lower bound*/;
109 }
110 for (++j; j < rank; ++j) {
111 at[j] += from[j - 1] - 1;
112 }
113}
114
115template <typename TYPE, typename ACCUMULATOR>
116inline void ReduceDimToScalar(const Descriptor &x, int zeroBasedDim,
117 SubscriptValue subscripts[], TYPE *result, ACCUMULATOR &accumulator) {
118 SubscriptValue xAt[maxRank];
119 GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
120 const auto &dim{x.GetDimension(zeroBasedDim)};
121 SubscriptValue at{dim.LowerBound()};
122 for (auto n{dim.Extent()}; n-- > 0; ++at) {
123 xAt[zeroBasedDim] = at;
124 if (!accumulator.template AccumulateAt<TYPE>(xAt)) {
125 break;
126 }
127 }
128#ifdef _MSC_VER // work around MSVC spurious error
129 accumulator.GetResult(result, zeroBasedDim);
130#else
131 accumulator.template GetResult(result, zeroBasedDim);
132#endif
133}
134
135template <typename TYPE, typename ACCUMULATOR>
136inline void ReduceDimMaskToScalar(const Descriptor &x, int zeroBasedDim,
137 SubscriptValue subscripts[], const Descriptor &mask, TYPE *result,
138 ACCUMULATOR &accumulator) {
139 SubscriptValue xAt[maxRank], maskAt[maxRank];
140 GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
141 GetExpandedSubscripts(maskAt, mask, zeroBasedDim, subscripts);
142 const auto &xDim{x.GetDimension(zeroBasedDim)};
143 SubscriptValue xPos{xDim.LowerBound()};
144 const auto &maskDim{mask.GetDimension(zeroBasedDim)};
145 SubscriptValue maskPos{maskDim.LowerBound()};
146 for (auto n{x.GetDimension(zeroBasedDim).Extent()}; n-- > 0;
147 ++xPos, ++maskPos) {
148 maskAt[zeroBasedDim] = maskPos;
149 if (IsLogicalElementTrue(mask, maskAt)) {
150 xAt[zeroBasedDim] = xPos;
151 if (!accumulator.template AccumulateAt<TYPE>(xAt)) {
152 break;
153 }
154 }
155 }
156#ifdef _MSC_VER // work around MSVC spurious error
157 accumulator.GetResult(result, zeroBasedDim);
158#else
159 accumulator.template GetResult(result, zeroBasedDim);
160#endif
161}
162
163// Utility: establishes & allocates the result array for a partial
164// reduction (i.e., one with DIM=).
165static void CreatePartialReductionResult(Descriptor &result,
166 const Descriptor &x, std::size_t resultElementSize, int dim,
167 Terminator &terminator, const char *intrinsic, TypeCode typeCode) {
168 int xRank{x.rank()};
169 if (dim < 1 || dim > xRank) {
170 terminator.Crash(
171 "%s: bad DIM=%d for ARRAY with rank %d", intrinsic, dim, xRank);
172 }
173 int zeroBasedDim{dim - 1};
174 SubscriptValue resultExtent[maxRank];
175 for (int j{0}; j < zeroBasedDim; ++j) {
176 resultExtent[j] = x.GetDimension(j).Extent();
177 }
178 for (int j{zeroBasedDim + 1}; j < xRank; ++j) {
179 resultExtent[j - 1] = x.GetDimension(j).Extent();
180 }
181 result.Establish(typeCode, resultElementSize, nullptr, xRank - 1,
182 resultExtent, CFI_attribute_allocatable2);
183 for (int j{0}; j + 1 < xRank; ++j) {
184 result.GetDimension(j).SetBounds(1, resultExtent[j]);
185 }
186 if (int stat{result.Allocate()}) {
187 terminator.Crash(
188 "%s: could not allocate memory for result; STAT=%d", intrinsic, stat);
189 }
190}
191
192// Partial reductions with DIM=
193
194template <typename ACCUMULATOR, TypeCategory CAT, int KIND>
195inline void PartialReduction(Descriptor &result, const Descriptor &x,
196 std::size_t resultElementSize, int dim, const Descriptor *mask,
197 Terminator &terminator, const char *intrinsic, ACCUMULATOR &accumulator) {
198 CreatePartialReductionResult(result, x, resultElementSize, dim, terminator,
199 intrinsic, TypeCode{CAT, KIND});
200 SubscriptValue at[maxRank];
201 result.GetLowerBounds(at);
202 INTERNAL_CHECK(result.rank() == 0 || at[0] == 1)if (result.rank() == 0 || at[0] == 1) ; else Terminator{"flang/runtime/reduction-templates.h"
, 202}.CheckFailed("result.rank() == 0 || at[0] == 1")
;
203 using CppType = CppTypeFor<CAT, KIND>;
204 if (mask) {
14
Assuming 'mask' is non-null
15
Taking true branch
205 CheckConformability(x, *mask, terminator, intrinsic, "ARRAY", "MASK");
206 SubscriptValue maskAt[maxRank]; // contents unused
207 if (mask->rank() > 0) {
16
Assuming the condition is false
17
Taking false branch
208 for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
209 accumulator.Reinitialize();
210 ReduceDimMaskToScalar<CppType, ACCUMULATOR>(
211 x, dim - 1, at, *mask, result.Element<CppType>(at), accumulator);
212 }
213 return;
214 } else if (!IsLogicalElementTrue(*mask, maskAt)) {
18
Taking true branch
215 // scalar MASK=.FALSE.
216 accumulator.Reinitialize();
217 for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
19
Assuming the condition is true
20
Loop condition is true. Entering loop body
218 accumulator.GetResult(result.Element<CppType>(at));
21
Calling 'LocationAccumulator::GetResult'
219 }
220 return;
221 }
222 }
223 // No MASK= or scalar MASK=.TRUE.
224 for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
225 accumulator.Reinitialize();
226 ReduceDimToScalar<CppType, ACCUMULATOR>(
227 x, dim - 1, at, result.Element<CppType>(at), accumulator);
228 }
229}
230
231template <template <typename> class ACCUM>
232struct PartialIntegerReductionHelper {
233 template <int KIND> struct Functor {
234 static constexpr int Intermediate{
235 std::max(KIND, 4)}; // use at least "int" for intermediate results
236 void operator()(Descriptor &result, const Descriptor &x, int dim,
237 const Descriptor *mask, Terminator &terminator,
238 const char *intrinsic) const {
239 using Accumulator =
240 ACCUM<CppTypeFor<TypeCategory::Integer, Intermediate>>;
241 Accumulator accumulator{x};
242 // Element size of the destination descriptor is the same
243 // as the element size of the source.
244 PartialReduction<Accumulator, TypeCategory::Integer, KIND>(result, x,
245 x.ElementBytes(), dim, mask, terminator, intrinsic, accumulator);
246 }
247 };
248};
249
250template <template <typename> class INTEGER_ACCUM>
251inline void PartialIntegerReduction(Descriptor &result, const Descriptor &x,
252 int dim, int kind, const Descriptor *mask, const char *intrinsic,
253 Terminator &terminator) {
254 ApplyIntegerKind<
255 PartialIntegerReductionHelper<INTEGER_ACCUM>::template Functor, void>(
256 kind, terminator, result, x, dim, mask, terminator, intrinsic);
257}
258
259template <TypeCategory CAT, template <typename> class ACCUM>
260struct PartialFloatingReductionHelper {
261 template <int KIND> struct Functor {
262 static constexpr int Intermediate{
263 std::max(KIND, 8)}; // use at least "double" for intermediate results
264 void operator()(Descriptor &result, const Descriptor &x, int dim,
265 const Descriptor *mask, Terminator &terminator,
266 const char *intrinsic) const {
267 using Accumulator = ACCUM<CppTypeFor<TypeCategory::Real, Intermediate>>;
268 Accumulator accumulator{x};
269 // Element size of the destination descriptor is the same
270 // as the element size of the source.
271 PartialReduction<Accumulator, CAT, KIND>(result, x, x.ElementBytes(), dim,
272 mask, terminator, intrinsic, accumulator);
273 }
274 };
275};
276
277template <template <typename> class INTEGER_ACCUM,
278 template <typename> class REAL_ACCUM,
279 template <typename> class COMPLEX_ACCUM>
280inline void TypedPartialNumericReduction(Descriptor &result,
281 const Descriptor &x, int dim, const char *source, int line,
282 const Descriptor *mask, const char *intrinsic) {
283 Terminator terminator{source, line};
284 auto catKind{x.type().GetCategoryAndKind()};
285 RUNTIME_CHECK(terminator, catKind.has_value())if (catKind.has_value()) ; else (terminator).CheckFailed("catKind.has_value()"
, "flang/runtime/reduction-templates.h", 285)
;
286 switch (catKind->first) {
287 case TypeCategory::Integer:
288 PartialIntegerReduction<INTEGER_ACCUM>(
289 result, x, dim, catKind->second, mask, intrinsic, terminator);
290 break;
291 case TypeCategory::Real:
292 ApplyFloatingPointKind<PartialFloatingReductionHelper<TypeCategory::Real,
293 REAL_ACCUM>::template Functor,
294 void>(catKind->second, terminator, result, x, dim, mask, terminator,
295 intrinsic);
296 break;
297 case TypeCategory::Complex:
298 ApplyFloatingPointKind<PartialFloatingReductionHelper<TypeCategory::Complex,
299 COMPLEX_ACCUM>::template Functor,
300 void>(catKind->second, terminator, result, x, dim, mask, terminator,
301 intrinsic);
302 break;
303 default:
304 terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw());
305 }
306}
307
308template <typename ACCUMULATOR> struct LocationResultHelper {
309 template <int KIND> struct Functor {
310 void operator()(ACCUMULATOR &accumulator, const Descriptor &result) const {
311 accumulator.GetResult(
312 result.OffsetElement<CppTypeFor<TypeCategory::Integer, KIND>>());
313 }
314 };
315};
316
317template <typename ACCUMULATOR> struct PartialLocationHelper {
318 template <int KIND> struct Functor {
319 void operator()(Descriptor &result, const Descriptor &x, int dim,
320 const Descriptor *mask, Terminator &terminator, const char *intrinsic,
321 ACCUMULATOR &accumulator) const {
322 // Element size of the destination descriptor is the size
323 // of {TypeCategory::Integer, KIND}.
324 PartialReduction<ACCUMULATOR, TypeCategory::Integer, KIND>(result, x,
13
Calling 'PartialReduction<Fortran::runtime::LocationAccumulator<Fortran::runtime::LogicalEquivalence>, Fortran::common::TypeCategory::Integer, 16>'
325 Descriptor::BytesFor(TypeCategory::Integer, KIND), dim, mask,
326 terminator, intrinsic, accumulator);
327 }
328 };
329};
330
331} // namespace Fortran::runtime
332#endif // FORTRAN_RUNTIME_REDUCTION_TEMPLATES_H_