Bug Summary

File:build/source/flang/runtime/reduction-templates.h
Warning:line 111, column 26
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 product.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/product.cpp

/build/source/flang/runtime/product.cpp

→
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
18namespace Fortran::runtime {
19template <typename INTERMEDIATE> class NonComplexProductAccumulator {
20public:
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
32private:
33 const Descriptor &array_;
34 INTERMEDIATE product_{1};
35};
36
37template <typename PART> class ComplexProductAccumulator {
38public:
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
51private:
52 const Descriptor &array_;
53 std::complex<PART> product_{1, 0};
54};
55
56extern "C" {
57CppTypeFor<TypeCategory::Integer, 1> RTNAME(ProductInteger1)_FortranAProductInteger1(
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}
64CppTypeFor<TypeCategory::Integer, 2> RTNAME(ProductInteger2)_FortranAProductInteger2(
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}
71CppTypeFor<TypeCategory::Integer, 4> RTNAME(ProductInteger4)_FortranAProductInteger4(
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}
78CppTypeFor<TypeCategory::Integer, 8> RTNAME(ProductInteger8)_FortranAProductInteger8(
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__16
86CppTypeFor<TypeCategory::Integer, 16> RTNAME(ProductInteger16)_FortranAProductInteger16(
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)
97CppTypeFor<TypeCategory::Real, 4> RTNAME(ProductReal4)_FortranAProductReal4(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}
103CppTypeFor<TypeCategory::Real, 8> RTNAME(ProductReal8)_FortranAProductReal8(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_DIG64 == 64
110CppTypeFor<TypeCategory::Real, 10> RTNAME(ProductReal10)_FortranAProductReal10(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_DIG64 == 113
117CppTypeFor<TypeCategory::Real, 16> RTNAME(ProductReal16)_FortranAProductReal16(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
125void RTNAME(CppProductComplex4)_FortranACppProductComplex4(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}
132void RTNAME(CppProductComplex8)_FortranACppProductComplex8(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_DIG64 == 64
140void RTNAME(CppProductComplex10)_FortranACppProductComplex10(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_DIG64 == 113
148void RTNAME(CppProductComplex16)_FortranACppProductComplex16(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
157void RTNAME(ProductDim)_FortranAProductDim(Descriptor &result, const Descriptor &x, int dim,
158 const char *source, int line, const Descriptor *mask) {
159 TypedPartialNumericReduction<NonComplexProductAccumulator,
1
Calling 'TypedPartialNumericReduction<Fortran::runtime::NonComplexProductAccumulator, Fortran::runtime::NonComplexProductAccumulator, Fortran::runtime::ComplexProductAccumulator>'
→
160 NonComplexProductAccumulator, ComplexProductAccumulator>(
161 result, x, dim, source, line, mask, "PRODUCT");
162}
163} // extern "C"
164} // namespace Fortran::runtime
←

/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) {
22
←
Loop condition is false. Execution continues on line 110
→
108 at[j] += from[j] - 1 /*lower bound*/;
109 }
110 for (++j; j < rank; ++j) {
23
←
Assuming 'j' is < 'rank'
→
24
←
Loop condition is true. Entering loop body
→
111 at[j] += from[j - 1] - 1;
25
←
The left operand of '-' is a garbage value
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);
21
←
Calling 'GetExpandedSubscripts'
→
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);
9
←
Calling 'Descriptor::GetLowerBounds'
→
13
←
Returning from 'Descriptor::GetLowerBounds'
→
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 true
→
17
←
Taking true branch
→
208 for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
18
←
Assuming the condition is true
→
19
←
Loop condition is true. Entering loop body
→
209 accumulator.Reinitialize();
210 ReduceDimMaskToScalar<CppType, ACCUMULATOR>(
20
←
Calling 'ReduceDimMaskToScalar<double, Fortran::runtime::NonComplexProductAccumulator<double>>'
→
211 x, dim - 1, at, *mask, result.Element<CppType>(at), accumulator);
212 }
213 return;
214 } else if (!IsLogicalElementTrue(*mask, maskAt)) {
215 // scalar MASK=.FALSE.
216 accumulator.Reinitialize();
217 for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
218 accumulator.GetResult(result.Element<CppType>(at));
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,
8
←
Calling 'PartialReduction<Fortran::runtime::NonComplexProductAccumulator<double>, Fortran::common::TypeCategory::Real, 8>'
→
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);
2
←
Assuming the condition is true
→
3
←
Taking true branch
→
286 switch (catKind->first) {
4
←
Control jumps to 'case Real:' at line 291
→
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,
5
←
Calling 'ApplyFloatingPointKind<Fortran::runtime::PartialFloatingReductionHelper<Fortran::common::TypeCategory::Real, Fortran::runtime::NonComplexProductAccumulator>::Functor, void, Fortran::runtime::Descriptor &, const Fortran::runtime::Descriptor &, int &, const Fortran::runtime::Descriptor *&, Fortran::runtime::Terminator &, const char *&>'
→
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,
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_
←

/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) {
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)...);
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) {
6
←
Control jumps to 'case 8:' at line 251
→
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)...);
7
←
Calling 'Functor::operator()'
→
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/include/flang/Runtime/descriptor.h

1//===-- include/flang/Runtime/descriptor.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_DESCRIPTOR_H_
10#define FORTRAN_RUNTIME_DESCRIPTOR_H_
11
12// Defines data structures used during execution of a Fortran program
13// to implement nontrivial dummy arguments, pointers, allocatables,
14// function results, and the special behaviors of instances of derived types.
15// This header file includes and extends the published language
16// interoperability header that is required by the Fortran 2018 standard
17// as a subset of definitions suitable for exposure to user C/C++ code.
18// User C code is welcome to depend on that ISO_Fortran_binding.h file,
19// but should never reference this internal header.
20
21#include "flang/ISO_Fortran_binding.h"
22#include "flang/Runtime/memory.h"
23#include "flang/Runtime/type-code.h"
24#include <algorithm>
25#include <cassert>
26#include <cinttypes>
27#include <cstddef>
28#include <cstdio>
29#include <cstring>
30
31namespace Fortran::runtime::typeInfo {
32using TypeParameterValue = std::int64_t;
33class DerivedType;
34} // namespace Fortran::runtime::typeInfo
35
36namespace Fortran::runtime {
37
38using SubscriptValue = ISO::CFI_index_t;
39
40static constexpr int maxRank{CFI_MAX_RANK15};
41
42// A C++ view of the sole interoperable standard descriptor (ISO::CFI_cdesc_t)
43// and its type and per-dimension information.
44
45class Dimension {
46public:
47 SubscriptValue LowerBound() const { return raw_.lower_bound; }
48 SubscriptValue Extent() const { return raw_.extent; }
49 SubscriptValue UpperBound() const { return LowerBound() + Extent() - 1; }
50 SubscriptValue ByteStride() const { return raw_.sm; }
51
52 Dimension &SetBounds(SubscriptValue lower, SubscriptValue upper) {
53 if (upper >= lower) {
54 raw_.lower_bound = lower;
55 raw_.extent = upper - lower + 1;
56 } else {
57 raw_.lower_bound = 1;
58 raw_.extent = 0;
59 }
60 return *this;
61 }
62 // Do not use this API to cause the LB of an empty dimension
63 // to be anything other than 1. Use SetBounds() instead if you can.
64 Dimension &SetLowerBound(SubscriptValue lower) {
65 raw_.lower_bound = lower;
66 return *this;
67 }
68 Dimension &SetUpperBound(SubscriptValue upper) {
69 auto lower{raw_.lower_bound};
70 raw_.extent = upper >= lower ? upper - lower + 1 : 0;
71 return *this;
72 }
73 Dimension &SetExtent(SubscriptValue extent) {
74 raw_.extent = extent;
75 return *this;
76 }
77 Dimension &SetByteStride(SubscriptValue bytes) {
78 raw_.sm = bytes;
79 return *this;
80 }
81
82private:
83 ISO::CFI_dim_t raw_;
84};
85
86// The storage for this object follows the last used dim[] entry in a
87// Descriptor (CFI_cdesc_t) generic descriptor. Space matters here, since
88// descriptors serve as POINTER and ALLOCATABLE components of derived type
89// instances. The presence of this structure is implied by the flag
90// CFI_cdesc_t.f18Addendum, and the number of elements in the len_[]
91// array is determined by derivedType_->LenParameters().
92class DescriptorAddendum {
93public:
94 explicit DescriptorAddendum(const typeInfo::DerivedType *dt = nullptr)
95 : derivedType_{dt} {}
96 DescriptorAddendum &operator=(const DescriptorAddendum &);
97
98 const typeInfo::DerivedType *derivedType() const { return derivedType_; }
99 DescriptorAddendum &set_derivedType(const typeInfo::DerivedType *dt) {
100 derivedType_ = dt;
101 return *this;
102 }
103
104 std::size_t LenParameters() const;
105
106 typeInfo::TypeParameterValue LenParameterValue(int which) const {
107 return len_[which];
108 }
109 static constexpr std::size_t SizeInBytes(int lenParameters) {
110 // TODO: Don't waste that last word if lenParameters == 0
111 return sizeof(DescriptorAddendum) +
112 std::max(lenParameters - 1, 0) * sizeof(typeInfo::TypeParameterValue);
113 }
114 std::size_t SizeInBytes() const;
115
116 void SetLenParameterValue(int which, typeInfo::TypeParameterValue x) {
117 len_[which] = x;
118 }
119
120 void Dump(FILE * = stdoutstdout) const;
121
122private:
123 const typeInfo::DerivedType *derivedType_;
124 typeInfo::TypeParameterValue len_[1]; // must be the last component
125 // The LEN type parameter values can also include captured values of
126 // specification expressions that were used for bounds and for LEN type
127 // parameters of components. The values have been truncated to the LEN
128 // type parameter's type, if shorter than 64 bits, then sign-extended.
129};
130
131// A C++ view of a standard descriptor object.
132class Descriptor {
133public:
134 // Be advised: this class type is not suitable for use when allocating
135 // a descriptor -- it is a dynamic view of the common descriptor format.
136 // If used in a simple declaration of a local variable or dynamic allocation,
137 // the size is going to be correct only by accident, since the true size of
138 // a descriptor depends on the number of its dimensions and the presence and
139 // size of an addendum, which depends on the type of the data.
140 // Use the class template StaticDescriptor (below) to declare a descriptor
141 // whose type and rank are fixed and known at compilation time. Use the
142 // Create() static member functions otherwise to dynamically allocate a
143 // descriptor.
144
145 Descriptor(const Descriptor &);
146 Descriptor &operator=(const Descriptor &);
147
148 // Returns the number of bytes occupied by an element of the given
149 // category and kind including any alignment padding required
150 // between adjacent elements.
151 static std::size_t BytesFor(TypeCategory category, int kind);
152
153 void Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
154 int rank = maxRank, const SubscriptValue *extent = nullptr,
155 ISO::CFI_attribute_t attribute = CFI_attribute_other0,
156 bool addendum = false);
157 void Establish(TypeCategory, int kind, void *p = nullptr, int rank = maxRank,
158 const SubscriptValue *extent = nullptr,
159 ISO::CFI_attribute_t attribute = CFI_attribute_other0,
160 bool addendum = false);
161 void Establish(int characterKind, std::size_t characters, void *p = nullptr,
162 int rank = maxRank, const SubscriptValue *extent = nullptr,
163 ISO::CFI_attribute_t attribute = CFI_attribute_other0,
164 bool addendum = false);
165 void Establish(const typeInfo::DerivedType &dt, void *p = nullptr,
166 int rank = maxRank, const SubscriptValue *extent = nullptr,
167 ISO::CFI_attribute_t attribute = CFI_attribute_other0);
168
169 static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
170 void *p = nullptr, int rank = maxRank,
171 const SubscriptValue *extent = nullptr,
172 ISO::CFI_attribute_t attribute = CFI_attribute_other0,
173 int derivedTypeLenParameters = 0);
174 static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
175 int rank = maxRank, const SubscriptValue *extent = nullptr,
176 ISO::CFI_attribute_t attribute = CFI_attribute_other0);
177 static OwningPtr<Descriptor> Create(int characterKind,
178 SubscriptValue characters, void *p = nullptr, int rank = maxRank,
179 const SubscriptValue *extent = nullptr,
180 ISO::CFI_attribute_t attribute = CFI_attribute_other0);
181 static OwningPtr<Descriptor> Create(const typeInfo::DerivedType &dt,
182 void *p = nullptr, int rank = maxRank,
183 const SubscriptValue *extent = nullptr,
184 ISO::CFI_attribute_t attribute = CFI_attribute_other0);
185
186 ISO::CFI_cdesc_t &raw() { return raw_; }
187 const ISO::CFI_cdesc_t &raw() const { return raw_; }
188 std::size_t ElementBytes() const { return raw_.elem_len; }
189 int rank() const { return raw_.rank; }
190 TypeCode type() const { return TypeCode{raw_.type}; }
191
192 Descriptor &set_base_addr(void *p) {
193 raw_.base_addr = p;
194 return *this;
195 }
196
197 bool IsPointer() const { return raw_.attribute == CFI_attribute_pointer1; }
198 bool IsAllocatable() const {
199 return raw_.attribute == CFI_attribute_allocatable2;
200 }
201 bool IsAllocated() const { return raw_.base_addr != nullptr; }
202
203 Dimension &GetDimension(int dim) {
204 return *reinterpret_cast<Dimension *>(&raw_.dim[dim]);
205 }
206 const Dimension &GetDimension(int dim) const {
207 return *reinterpret_cast<const Dimension *>(&raw_.dim[dim]);
208 }
209
210 std::size_t SubscriptByteOffset(
211 int dim, SubscriptValue subscriptValue) const {
212 const Dimension &dimension{GetDimension(dim)};
213 return (subscriptValue - dimension.LowerBound()) * dimension.ByteStride();
214 }
215
216 std::size_t SubscriptsToByteOffset(const SubscriptValue subscript[]) const {
217 std::size_t offset{0};
218 for (int j{0}; j < raw_.rank; ++j) {
219 offset += SubscriptByteOffset(j, subscript[j]);
220 }
221 return offset;
222 }
223
224 template <typename A = char> A *OffsetElement(std::size_t offset = 0) const {
225 return reinterpret_cast<A *>(
226 reinterpret_cast<char *>(raw_.base_addr) + offset);
227 }
228
229 template <typename A> A *Element(const SubscriptValue subscript[]) const {
230 return OffsetElement<A>(SubscriptsToByteOffset(subscript));
231 }
232
233 template <typename A> A *ZeroBasedIndexedElement(std::size_t n) const {
234 SubscriptValue at[maxRank];
235 if (SubscriptsForZeroBasedElementNumber(at, n)) {
236 return Element<A>(at);
237 }
238 return nullptr;
239 }
240
241 int GetLowerBounds(SubscriptValue subscript[]) const {
242 for (int j{0}; j < raw_.rank; ++j) {
10
←
Assuming 'j' is >= field 'rank'
→
11
←
Loop condition is false. Execution continues on line 245
→
243 subscript[j] = GetDimension(j).LowerBound();
244 }
245 return raw_.rank;
12
←
Returning without writing to '*subscript'
→
246 }
247
248 int GetShape(SubscriptValue subscript[]) const {
249 for (int j{0}; j < raw_.rank; ++j) {
250 subscript[j] = GetDimension(j).Extent();
251 }
252 return raw_.rank;
253 }
254
255 // When the passed subscript vector contains the last (or first)
256 // subscripts of the array, these wrap the subscripts around to
257 // their first (or last) values and return false.
258 bool IncrementSubscripts(
259 SubscriptValue subscript[], const int *permutation = nullptr) const {
260 for (int j{0}; j < raw_.rank; ++j) {
261 int k{permutation ? permutation[j] : j};
262 const Dimension &dim{GetDimension(k)};
263 if (subscript[k]++ < dim.UpperBound()) {
264 return true;
265 }
266 subscript[k] = dim.LowerBound();
267 }
268 return false;
269 }
270
271 bool DecrementSubscripts(
272 SubscriptValue[], const int *permutation = nullptr) const;
273
274 // False when out of range.
275 bool SubscriptsForZeroBasedElementNumber(SubscriptValue subscript[],
276 std::size_t elementNumber, const int *permutation = nullptr) const {
277 if (raw_.rank == 0) {
278 return elementNumber == 0;
279 }
280 std::size_t dimCoefficient[maxRank];
281 int k0{permutation ? permutation[0] : 0};
282 dimCoefficient[0] = 1;
283 auto coefficient{static_cast<std::size_t>(GetDimension(k0).Extent())};
284 for (int j{1}; j < raw_.rank; ++j) {
285 int k{permutation ? permutation[j] : j};
286 const Dimension &dim{GetDimension(k)};
287 dimCoefficient[j] = coefficient;
288 coefficient *= dim.Extent();
289 }
290 if (elementNumber >= coefficient) {
291 return false; // out of range
292 }
293 for (int j{raw_.rank - 1}; j > 0; --j) {
294 int k{permutation ? permutation[j] : j};
295 const Dimension &dim{GetDimension(k)};
296 std::size_t quotient{elementNumber / dimCoefficient[j]};
297 subscript[k] = quotient + dim.LowerBound();
298 elementNumber -= quotient * dimCoefficient[j];
299 }
300 subscript[k0] = elementNumber + GetDimension(k0).LowerBound();
301 return true;
302 }
303
304 std::size_t ZeroBasedElementNumber(
305 const SubscriptValue *, const int *permutation = nullptr) const;
306
307 DescriptorAddendum *Addendum() {
308 if (raw_.f18Addendum != 0) {
309 return reinterpret_cast<DescriptorAddendum *>(&GetDimension(rank()));
310 } else {
311 return nullptr;
312 }
313 }
314 const DescriptorAddendum *Addendum() const {
315 if (raw_.f18Addendum != 0) {
316 return reinterpret_cast<const DescriptorAddendum *>(
317 &GetDimension(rank()));
318 } else {
319 return nullptr;
320 }
321 }
322
323 // Returns size in bytes of the descriptor (not the data)
324 static constexpr std::size_t SizeInBytes(
325 int rank, bool addendum = false, int lengthTypeParameters = 0) {
326 std::size_t bytes{sizeof(Descriptor) - sizeof(Dimension)};
327 bytes += rank * sizeof(Dimension);
328 if (addendum || lengthTypeParameters > 0) {
329 bytes += DescriptorAddendum::SizeInBytes(lengthTypeParameters);
330 }
331 return bytes;
332 }
333
334 std::size_t SizeInBytes() const;
335
336 std::size_t Elements() const;
337
338 // Allocate() assumes Elements() and ElementBytes() work;
339 // define the extents of the dimensions and the element length
340 // before calling. It (re)computes the byte strides after
341 // allocation. Does not allocate automatic components or
342 // perform default component initialization.
343 int Allocate();
344
345 // Deallocates storage; does not call FINAL subroutines or
346 // deallocate allocatable/automatic components.
347 int Deallocate();
348
349 // Deallocates storage, including allocatable and automatic
350 // components. Optionally invokes FINAL subroutines.
351 int Destroy(bool finalize = false, bool destroyPointers = false);
352
353 bool IsContiguous(int leadingDimensions = maxRank) const {
354 auto bytes{static_cast<SubscriptValue>(ElementBytes())};
355 if (leadingDimensions > raw_.rank) {
356 leadingDimensions = raw_.rank;
357 }
358 for (int j{0}; j < leadingDimensions; ++j) {
359 const Dimension &dim{GetDimension(j)};
360 if (bytes != dim.ByteStride()) {
361 return false;
362 }
363 bytes *= dim.Extent();
364 }
365 return true;
366 }
367
368 // Establishes a pointer to a section or element.
369 bool EstablishPointerSection(const Descriptor &source,
370 const SubscriptValue *lower = nullptr,
371 const SubscriptValue *upper = nullptr,
372 const SubscriptValue *stride = nullptr);
373
374 void Check() const;
375
376 void Dump(FILE * = stdoutstdout) const;
377
378private:
379 ISO::CFI_cdesc_t raw_;
380};
381static_assert(sizeof(Descriptor) == sizeof(ISO::CFI_cdesc_t));
382
383// Properly configured instances of StaticDescriptor will occupy the
384// exact amount of storage required for the descriptor, its dimensional
385// information, and possible addendum. To build such a static descriptor,
386// declare an instance of StaticDescriptor<>, extract a reference to its
387// descriptor via the descriptor() accessor, and then built a Descriptor
388// therein via descriptor.Establish(), e.g.:
389// StaticDescriptor<R,A,LP> statDesc;
390// Descriptor &descriptor{statDesc.descriptor()};
391// descriptor.Establish( ... );
392template <int MAX_RANK = maxRank, bool ADDENDUM = false, int MAX_LEN_PARMS = 0>
393class alignas(Descriptor) StaticDescriptor {
394public:
395 static constexpr int maxRank{MAX_RANK};
396 static constexpr int maxLengthTypeParameters{MAX_LEN_PARMS};
397 static constexpr bool hasAddendum{ADDENDUM || MAX_LEN_PARMS > 0};
398 static constexpr std::size_t byteSize{
399 Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
400
401 Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
402 const Descriptor &descriptor() const {
403 return *reinterpret_cast<const Descriptor *>(storage_);
404 }
405
406 void Check() {
407 assert(descriptor().rank() <= maxRank)(static_cast <bool> (descriptor().rank() <= maxRank)
? void (0) : __assert_fail ("descriptor().rank() <= maxRank"
, "flang/include/flang/Runtime/descriptor.h", 407, __extension__
__PRETTY_FUNCTION__));
408 assert(descriptor().SizeInBytes() <= byteSize)(static_cast <bool> (descriptor().SizeInBytes() <= byteSize
) ? void (0) : __assert_fail ("descriptor().SizeInBytes() <= byteSize"
, "flang/include/flang/Runtime/descriptor.h", 408, __extension__
__PRETTY_FUNCTION__));
409 if (DescriptorAddendum * addendum{descriptor().Addendum()}) {
410 assert(hasAddendum)(static_cast <bool> (hasAddendum) ? void (0) : __assert_fail
("hasAddendum", "flang/include/flang/Runtime/descriptor.h", 410
, __extension__ __PRETTY_FUNCTION__));
411 assert(addendum->LenParameters() <= maxLengthTypeParameters)(static_cast <bool> (addendum->LenParameters() <=
maxLengthTypeParameters) ? void (0) : __assert_fail ("addendum->LenParameters() <= maxLengthTypeParameters"
, "flang/include/flang/Runtime/descriptor.h", 411, __extension__
__PRETTY_FUNCTION__));
412 } else {
413 assert(!hasAddendum)(static_cast <bool> (!hasAddendum) ? void (0) : __assert_fail
("!hasAddendum", "flang/include/flang/Runtime/descriptor.h",
413, __extension__ __PRETTY_FUNCTION__));
414 assert(maxLengthTypeParameters == 0)(static_cast <bool> (maxLengthTypeParameters == 0) ? void
(0) : __assert_fail ("maxLengthTypeParameters == 0", "flang/include/flang/Runtime/descriptor.h"
, 414, __extension__ __PRETTY_FUNCTION__));
415 }
416 descriptor().Check();
417 }
418
419private:
420 char storage_[byteSize]{};
421};
422} // namespace Fortran::runtime
423#endif // FORTRAN_RUNTIME_DESCRIPTOR_H_