1//===-- Reduction.cpp -- generate reduction intrinsics runtime calls- -----===//
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#include "flang/Optimizer/Builder/Runtime/Reduction.h"
10#include "flang/Optimizer/Builder/BoxValue.h"
11#include "flang/Optimizer/Builder/Character.h"
12#include "flang/Optimizer/Builder/FIRBuilder.h"
13#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
14#include "flang/Optimizer/Support/Utils.h"
15#include "flang/Runtime/reduction.h"
16#include "mlir/Dialect/Func/IR/FuncOps.h"
17
18using namespace Fortran::runtime;
19
20#define STRINGIFY(S) #S
21#define JOIN2(A, B) A##B
22#define JOIN3(A, B, C) A##B##C
23
24/// Placeholder for real*10 version of Maxval Intrinsic
25struct ForcedMaxvalReal10 {
26 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MaxvalReal10));
27 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
28 return [](mlir::MLIRContext *ctx) {
29 auto ty = mlir::FloatType::getF80(ctx);
30 auto boxTy =
31 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
32 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
33 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
34 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
35 {ty});
36 };
37 }
38};
39
40/// Placeholder for real*16 version of Maxval Intrinsic
41struct ForcedMaxvalReal16 {
42 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MaxvalReal16));
43 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
44 return [](mlir::MLIRContext *ctx) {
45 auto ty = mlir::FloatType::getF128(ctx);
46 auto boxTy =
47 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
48 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
49 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
50 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
51 {ty});
52 };
53 }
54};
55
56/// Placeholder for integer*16 version of Maxval Intrinsic
57struct ForcedMaxvalInteger16 {
58 static constexpr const char *name =
59 ExpandAndQuoteKey(RTNAME(MaxvalInteger16));
60 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
61 return [](mlir::MLIRContext *ctx) {
62 auto ty = mlir::IntegerType::get(ctx, 128);
63 auto boxTy =
64 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
65 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
66 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
67 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
68 {ty});
69 };
70 }
71};
72
73/// Placeholder for real*10 version of Minval Intrinsic
74struct ForcedMinvalReal10 {
75 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal10));
76 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
77 return [](mlir::MLIRContext *ctx) {
78 auto ty = mlir::FloatType::getF80(ctx);
79 auto boxTy =
80 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
81 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
82 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
83 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
84 {ty});
85 };
86 }
87};
88
89/// Placeholder for real*16 version of Minval Intrinsic
90struct ForcedMinvalReal16 {
91 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal16));
92 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
93 return [](mlir::MLIRContext *ctx) {
94 auto ty = mlir::FloatType::getF128(ctx);
95 auto boxTy =
96 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
97 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
98 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
99 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
100 {ty});
101 };
102 }
103};
104
105/// Placeholder for integer*16 version of Minval Intrinsic
106struct ForcedMinvalInteger16 {
107 static constexpr const char *name =
108 ExpandAndQuoteKey(RTNAME(MinvalInteger16));
109 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
110 return [](mlir::MLIRContext *ctx) {
111 auto ty = mlir::IntegerType::get(ctx, 128);
112 auto boxTy =
113 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
114 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
115 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
116 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
117 {ty});
118 };
119 }
120};
121
122/// Placeholder for real*10 version of Norm2 Intrinsic
123struct ForcedNorm2Real10 {
124 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Norm2_10));
125 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
126 return [](mlir::MLIRContext *ctx) {
127 auto ty = mlir::FloatType::getF80(ctx);
128 auto boxTy =
129 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
130 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
131 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
132 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy}, {ty});
133 };
134 }
135};
136
137/// Placeholder for real*16 version of Norm2 Intrinsic
138struct ForcedNorm2Real16 {
139 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Norm2_16));
140 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
141 return [](mlir::MLIRContext *ctx) {
142 auto ty = mlir::FloatType::getF128(ctx);
143 auto boxTy =
144 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
145 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
146 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
147 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy}, {ty});
148 };
149 }
150};
151
152/// Placeholder for real*16 version of Norm2Dim Intrinsic
153struct ForcedNorm2DimReal16 {
154 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Norm2DimReal16));
155 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
156 return [](mlir::MLIRContext *ctx) {
157 auto boxTy =
158 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
159 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
160 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
161 return mlir::FunctionType::get(
162 ctx, {fir::ReferenceType::get(boxTy), boxTy, intTy, strTy, intTy},
163 mlir::NoneType::get(ctx));
164 };
165 }
166};
167
168/// Placeholder for real*10 version of Product Intrinsic
169struct ForcedProductReal10 {
170 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ProductReal10));
171 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
172 return [](mlir::MLIRContext *ctx) {
173 auto ty = mlir::FloatType::getF80(ctx);
174 auto boxTy =
175 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
176 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
177 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
178 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
179 {ty});
180 };
181 }
182};
183
184/// Placeholder for real*16 version of Product Intrinsic
185struct ForcedProductReal16 {
186 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ProductReal16));
187 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
188 return [](mlir::MLIRContext *ctx) {
189 auto ty = mlir::FloatType::getF128(ctx);
190 auto boxTy =
191 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
192 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
193 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
194 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
195 {ty});
196 };
197 }
198};
199
200/// Placeholder for integer*16 version of Product Intrinsic
201struct ForcedProductInteger16 {
202 static constexpr const char *name =
203 ExpandAndQuoteKey(RTNAME(ProductInteger16));
204 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
205 return [](mlir::MLIRContext *ctx) {
206 auto ty = mlir::IntegerType::get(ctx, 128);
207 auto boxTy =
208 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
209 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
210 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
211 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
212 {ty});
213 };
214 }
215};
216
217/// Placeholder for complex(10) version of Product Intrinsic
218struct ForcedProductComplex10 {
219 static constexpr const char *name =
220 ExpandAndQuoteKey(RTNAME(CppProductComplex10));
221 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
222 return [](mlir::MLIRContext *ctx) {
223 auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(ctx));
224 auto boxTy =
225 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
226 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
227 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
228 auto resTy = fir::ReferenceType::get(ty);
229 return mlir::FunctionType::get(
230 ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
231 };
232 }
233};
234
235/// Placeholder for complex(16) version of Product Intrinsic
236struct ForcedProductComplex16 {
237 static constexpr const char *name =
238 ExpandAndQuoteKey(RTNAME(CppProductComplex16));
239 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
240 return [](mlir::MLIRContext *ctx) {
241 auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
242 auto boxTy =
243 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
244 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
245 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
246 auto resTy = fir::ReferenceType::get(ty);
247 return mlir::FunctionType::get(
248 ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
249 };
250 }
251};
252
253/// Placeholder for real*10 version of DotProduct Intrinsic
254struct ForcedDotProductReal10 {
255 static constexpr const char *name =
256 ExpandAndQuoteKey(RTNAME(DotProductReal10));
257 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
258 return [](mlir::MLIRContext *ctx) {
259 auto ty = mlir::FloatType::getF80(ctx);
260 auto boxTy =
261 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
262 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
263 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
264 return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
265 };
266 }
267};
268
269/// Placeholder for real*16 version of DotProduct Intrinsic
270struct ForcedDotProductReal16 {
271 static constexpr const char *name =
272 ExpandAndQuoteKey(RTNAME(DotProductReal16));
273 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
274 return [](mlir::MLIRContext *ctx) {
275 auto ty = mlir::FloatType::getF128(ctx);
276 auto boxTy =
277 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
278 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
279 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
280 return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
281 };
282 }
283};
284
285/// Placeholder for complex(10) version of DotProduct Intrinsic
286struct ForcedDotProductComplex10 {
287 static constexpr const char *name =
288 ExpandAndQuoteKey(RTNAME(CppDotProductComplex10));
289 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
290 return [](mlir::MLIRContext *ctx) {
291 auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(ctx));
292 auto boxTy =
293 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
294 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
295 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
296 auto resTy = fir::ReferenceType::get(ty);
297 return mlir::FunctionType::get(ctx, {resTy, boxTy, boxTy, strTy, intTy},
298 {});
299 };
300 }
301};
302
303/// Placeholder for complex(16) version of DotProduct Intrinsic
304struct ForcedDotProductComplex16 {
305 static constexpr const char *name =
306 ExpandAndQuoteKey(RTNAME(CppDotProductComplex16));
307 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
308 return [](mlir::MLIRContext *ctx) {
309 auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
310 auto boxTy =
311 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
312 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
313 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
314 auto resTy = fir::ReferenceType::get(ty);
315 return mlir::FunctionType::get(ctx, {resTy, boxTy, boxTy, strTy, intTy},
316 {});
317 };
318 }
319};
320
321/// Placeholder for integer*16 version of DotProduct Intrinsic
322struct ForcedDotProductInteger16 {
323 static constexpr const char *name =
324 ExpandAndQuoteKey(RTNAME(DotProductInteger16));
325 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
326 return [](mlir::MLIRContext *ctx) {
327 auto ty = mlir::IntegerType::get(ctx, 128);
328 auto boxTy =
329 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
330 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
331 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
332 return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
333 };
334 }
335};
336
337/// Placeholder for real*10 version of Sum Intrinsic
338struct ForcedSumReal10 {
339 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal10));
340 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
341 return [](mlir::MLIRContext *ctx) {
342 auto ty = mlir::FloatType::getF80(ctx);
343 auto boxTy =
344 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
345 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
346 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
347 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
348 {ty});
349 };
350 }
351};
352
353/// Placeholder for real*16 version of Sum Intrinsic
354struct ForcedSumReal16 {
355 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal16));
356 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
357 return [](mlir::MLIRContext *ctx) {
358 auto ty = mlir::FloatType::getF128(ctx);
359 auto boxTy =
360 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
361 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
362 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
363 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
364 {ty});
365 };
366 }
367};
368
369/// Placeholder for integer*16 version of Sum Intrinsic
370struct ForcedSumInteger16 {
371 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumInteger16));
372 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
373 return [](mlir::MLIRContext *ctx) {
374 auto ty = mlir::IntegerType::get(ctx, 128);
375 auto boxTy =
376 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
377 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
378 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
379 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
380 {ty});
381 };
382 }
383};
384
385/// Placeholder for complex(10) version of Sum Intrinsic
386struct ForcedSumComplex10 {
387 static constexpr const char *name =
388 ExpandAndQuoteKey(RTNAME(CppSumComplex10));
389 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
390 return [](mlir::MLIRContext *ctx) {
391 auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(ctx));
392 auto boxTy =
393 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
394 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
395 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
396 auto resTy = fir::ReferenceType::get(ty);
397 return mlir::FunctionType::get(
398 ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
399 };
400 }
401};
402
403/// Placeholder for complex(16) version of Sum Intrinsic
404struct ForcedSumComplex16 {
405 static constexpr const char *name =
406 ExpandAndQuoteKey(RTNAME(CppSumComplex16));
407 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
408 return [](mlir::MLIRContext *ctx) {
409 auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
410 auto boxTy =
411 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
412 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
413 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
414 auto resTy = fir::ReferenceType::get(ty);
415 return mlir::FunctionType::get(
416 ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
417 };
418 }
419};
420
421/// Placeholder for integer(16) version of IAll Intrinsic
422struct ForcedIAll16 {
423 static constexpr const char *name = EXPAND_AND_QUOTE_KEY(IAll16);
424 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
425 return [](mlir::MLIRContext *ctx) {
426 auto ty = mlir::IntegerType::get(ctx, 128);
427 auto boxTy =
428 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
429 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
430 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
431 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
432 {ty});
433 };
434 }
435};
436
437/// Placeholder for integer(16) version of IAny Intrinsic
438struct ForcedIAny16 {
439 static constexpr const char *name = EXPAND_AND_QUOTE_KEY(IAny16);
440 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
441 return [](mlir::MLIRContext *ctx) {
442 auto ty = mlir::IntegerType::get(ctx, 128);
443 auto boxTy =
444 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
445 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
446 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
447 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
448 {ty});
449 };
450 }
451};
452
453/// Placeholder for integer(16) version of IParity Intrinsic
454struct ForcedIParity16 {
455 static constexpr const char *name = EXPAND_AND_QUOTE_KEY(IParity16);
456 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
457 return [](mlir::MLIRContext *ctx) {
458 auto ty = mlir::IntegerType::get(ctx, 128);
459 auto boxTy =
460 fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
461 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
462 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
463 return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
464 {ty});
465 };
466 }
467};
468
469/// Generate call to specialized runtime function that takes a mask and
470/// dim argument. The All, Any, and Count intrinsics use this pattern.
471template <typename FN>
472mlir::Value genSpecial2Args(FN func, fir::FirOpBuilder &builder,
473 mlir::Location loc, mlir::Value maskBox,
474 mlir::Value dim) {
475 auto fTy = func.getFunctionType();
476 auto sourceFile = fir::factory::locationToFilename(builder, loc);
477 auto sourceLine =
478 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
479 auto args = fir::runtime::createArguments(builder, loc, fTy, maskBox,
480 sourceFile, sourceLine, dim);
481 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
482}
483
484/// Generate calls to reduction intrinsics such as All and Any.
485/// These are the descriptor based implementations that take two
486/// arguments (mask, dim).
487template <typename FN>
488static void genReduction2Args(FN func, fir::FirOpBuilder &builder,
489 mlir::Location loc, mlir::Value resultBox,
490 mlir::Value maskBox, mlir::Value dim) {
491 auto fTy = func.getFunctionType();
492 auto sourceFile = fir::factory::locationToFilename(builder, loc);
493 auto sourceLine =
494 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
495 auto args = fir::runtime::createArguments(
496 builder, loc, fTy, resultBox, maskBox, dim, sourceFile, sourceLine);
497 builder.create<fir::CallOp>(loc, func, args);
498}
499
500/// Generate calls to reduction intrinsics such as Maxval and Minval.
501/// These take arguments such as (array, dim, mask).
502template <typename FN>
503static void genReduction3Args(FN func, fir::FirOpBuilder &builder,
504 mlir::Location loc, mlir::Value resultBox,
505 mlir::Value arrayBox, mlir::Value dim,
506 mlir::Value maskBox) {
507
508 auto fTy = func.getFunctionType();
509 auto sourceFile = fir::factory::locationToFilename(builder, loc);
510 auto sourceLine =
511 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
512 auto args =
513 fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox, dim,
514 sourceFile, sourceLine, maskBox);
515 builder.create<fir::CallOp>(loc, func, args);
516}
517
518/// Generate calls to reduction intrinsics such as Maxloc and Minloc.
519/// These take arguments such as (array, mask, kind, back).
520template <typename FN>
521static void genReduction4Args(FN func, fir::FirOpBuilder &builder,
522 mlir::Location loc, mlir::Value resultBox,
523 mlir::Value arrayBox, mlir::Value maskBox,
524 mlir::Value kind, mlir::Value back) {
525 auto fTy = func.getFunctionType();
526 auto sourceFile = fir::factory::locationToFilename(builder, loc);
527 auto sourceLine =
528 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
529 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
530 arrayBox, kind, sourceFile,
531 sourceLine, maskBox, back);
532 builder.create<fir::CallOp>(loc, func, args);
533}
534
535/// Generate calls to reduction intrinsics such as Maxloc and Minloc.
536/// These take arguments such as (array, dim, mask, kind, back).
537template <typename FN>
538static void
539genReduction5Args(FN func, fir::FirOpBuilder &builder, mlir::Location loc,
540 mlir::Value resultBox, mlir::Value arrayBox, mlir::Value dim,
541 mlir::Value maskBox, mlir::Value kind, mlir::Value back) {
542 auto fTy = func.getFunctionType();
543 auto sourceFile = fir::factory::locationToFilename(builder, loc);
544 auto sourceLine =
545 fir::factory::locationToLineNo(builder, loc, fTy.getInput(5));
546 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
547 arrayBox, kind, dim, sourceFile,
548 sourceLine, maskBox, back);
549 builder.create<fir::CallOp>(loc, func, args);
550}
551
552/// Generate call to `AllDim` runtime routine.
553/// This calls the descriptor based runtime call implementation of the `all`
554/// intrinsic.
555void fir::runtime::genAllDescriptor(fir::FirOpBuilder &builder,
556 mlir::Location loc, mlir::Value resultBox,
557 mlir::Value maskBox, mlir::Value dim) {
558 auto allFunc = fir::runtime::getRuntimeFunc<mkRTKey(AllDim)>(loc, builder);
559 genReduction2Args(allFunc, builder, loc, resultBox, maskBox, dim);
560}
561
562/// Generate call to `AnyDim` runtime routine.
563/// This calls the descriptor based runtime call implementation of the `any`
564/// intrinsic.
565void fir::runtime::genAnyDescriptor(fir::FirOpBuilder &builder,
566 mlir::Location loc, mlir::Value resultBox,
567 mlir::Value maskBox, mlir::Value dim) {
568 auto anyFunc = fir::runtime::getRuntimeFunc<mkRTKey(AnyDim)>(loc, builder);
569 genReduction2Args(anyFunc, builder, loc, resultBox, maskBox, dim);
570}
571
572/// Generate call to `ParityDim` runtime routine.
573/// This calls the descriptor based runtime call implementation of the `parity`
574/// intrinsic.
575void fir::runtime::genParityDescriptor(fir::FirOpBuilder &builder,
576 mlir::Location loc,
577 mlir::Value resultBox,
578 mlir::Value maskBox, mlir::Value dim) {
579 auto parityFunc =
580 fir::runtime::getRuntimeFunc<mkRTKey(ParityDim)>(loc, builder);
581 genReduction2Args(parityFunc, builder, loc, resultBox, maskBox, dim);
582}
583
584/// Generate call to `All` intrinsic runtime routine. This routine is
585/// specialized for mask arguments with rank == 1.
586mlir::Value fir::runtime::genAll(fir::FirOpBuilder &builder, mlir::Location loc,
587 mlir::Value maskBox, mlir::Value dim) {
588 auto allFunc = fir::runtime::getRuntimeFunc<mkRTKey(All)>(loc, builder);
589 return genSpecial2Args(allFunc, builder, loc, maskBox, dim);
590}
591
592/// Generate call to `Any` intrinsic runtime routine. This routine is
593/// specialized for mask arguments with rank == 1.
594mlir::Value fir::runtime::genAny(fir::FirOpBuilder &builder, mlir::Location loc,
595 mlir::Value maskBox, mlir::Value dim) {
596 auto anyFunc = fir::runtime::getRuntimeFunc<mkRTKey(Any)>(loc, builder);
597 return genSpecial2Args(anyFunc, builder, loc, maskBox, dim);
598}
599
600/// Generate call to `Count` runtime routine. This routine is a specialized
601/// version when mask is a rank one array or the dim argument is not
602/// specified by the user.
603mlir::Value fir::runtime::genCount(fir::FirOpBuilder &builder,
604 mlir::Location loc, mlir::Value maskBox,
605 mlir::Value dim) {
606 auto countFunc = fir::runtime::getRuntimeFunc<mkRTKey(Count)>(loc, builder);
607 return genSpecial2Args(countFunc, builder, loc, maskBox, dim);
608}
609
610/// Generate call to general `CountDim` runtime routine. This routine has a
611/// descriptor result.
612void fir::runtime::genCountDim(fir::FirOpBuilder &builder, mlir::Location loc,
613 mlir::Value resultBox, mlir::Value maskBox,
614 mlir::Value dim, mlir::Value kind) {
615 auto func = fir::runtime::getRuntimeFunc<mkRTKey(CountDim)>(loc, builder);
616 auto fTy = func.getFunctionType();
617 auto sourceFile = fir::factory::locationToFilename(builder, loc);
618 auto sourceLine =
619 fir::factory::locationToLineNo(builder, loc, fTy.getInput(5));
620 auto args = fir::runtime::createArguments(
621 builder, loc, fTy, resultBox, maskBox, dim, kind, sourceFile, sourceLine);
622 builder.create<fir::CallOp>(loc, func, args);
623}
624
625/// Generate call to `Findloc` intrinsic runtime routine. This is the version
626/// that does not take a dim argument.
627void fir::runtime::genFindloc(fir::FirOpBuilder &builder, mlir::Location loc,
628 mlir::Value resultBox, mlir::Value arrayBox,
629 mlir::Value valBox, mlir::Value maskBox,
630 mlir::Value kind, mlir::Value back) {
631 auto func = fir::runtime::getRuntimeFunc<mkRTKey(Findloc)>(loc, builder);
632 auto fTy = func.getFunctionType();
633 auto sourceFile = fir::factory::locationToFilename(builder, loc);
634 auto sourceLine =
635 fir::factory::locationToLineNo(builder, loc, fTy.getInput(5));
636 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
637 arrayBox, valBox, kind, sourceFile,
638 sourceLine, maskBox, back);
639 builder.create<fir::CallOp>(loc, func, args);
640}
641
642/// Generate call to `FindlocDim` intrinsic runtime routine. This is the version
643/// that takes a dim argument.
644void fir::runtime::genFindlocDim(fir::FirOpBuilder &builder, mlir::Location loc,
645 mlir::Value resultBox, mlir::Value arrayBox,
646 mlir::Value valBox, mlir::Value dim,
647 mlir::Value maskBox, mlir::Value kind,
648 mlir::Value back) {
649 auto func = fir::runtime::getRuntimeFunc<mkRTKey(FindlocDim)>(loc, builder);
650 auto fTy = func.getFunctionType();
651 auto sourceFile = fir::factory::locationToFilename(builder, loc);
652 auto sourceLine =
653 fir::factory::locationToLineNo(builder, loc, fTy.getInput(6));
654 auto args = fir::runtime::createArguments(
655 builder, loc, fTy, resultBox, arrayBox, valBox, kind, dim, sourceFile,
656 sourceLine, maskBox, back);
657 builder.create<fir::CallOp>(loc, func, args);
658}
659
660/// Generate call to `Maxloc` intrinsic runtime routine. This is the version
661/// that does not take a dim argument.
662void fir::runtime::genMaxloc(fir::FirOpBuilder &builder, mlir::Location loc,
663 mlir::Value resultBox, mlir::Value arrayBox,
664 mlir::Value maskBox, mlir::Value kind,
665 mlir::Value back) {
666 mlir::func::FuncOp func;
667 auto ty = arrayBox.getType();
668 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
669 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
670 fir::factory::CharacterExprHelper charHelper{builder, loc};
671 if (eleTy.isF32())
672 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocReal4)>(loc, builder);
673 else if (eleTy.isF64())
674 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocReal8)>(loc, builder);
675 else if (eleTy.isF80())
676 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocReal10)>(loc, builder);
677 else if (eleTy.isF128())
678 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocReal16)>(loc, builder);
679 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
680 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocInteger1)>(loc, builder);
681 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
682 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocInteger2)>(loc, builder);
683 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
684 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocInteger4)>(loc, builder);
685 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
686 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocInteger8)>(loc, builder);
687 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
688 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocInteger16)>(loc, builder);
689 else if (charHelper.isCharacterScalar(eleTy))
690 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocCharacter)>(loc, builder);
691 else
692 fir::intrinsicTypeTODO(builder, eleTy, loc, "MAXLOC");
693 genReduction4Args(func, builder, loc, resultBox, arrayBox, maskBox, kind,
694 back);
695}
696
697/// Generate call to `MaxlocDim` intrinsic runtime routine. This is the version
698/// that takes a dim argument.
699void fir::runtime::genMaxlocDim(fir::FirOpBuilder &builder, mlir::Location loc,
700 mlir::Value resultBox, mlir::Value arrayBox,
701 mlir::Value dim, mlir::Value maskBox,
702 mlir::Value kind, mlir::Value back) {
703 auto func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocDim)>(loc, builder);
704 genReduction5Args(func, builder, loc, resultBox, arrayBox, dim, maskBox, kind,
705 back);
706}
707
708/// Generate call to `Maxval` intrinsic runtime routine. This is the version
709/// that does not take a dim argument.
710mlir::Value fir::runtime::genMaxval(fir::FirOpBuilder &builder,
711 mlir::Location loc, mlir::Value arrayBox,
712 mlir::Value maskBox) {
713 mlir::func::FuncOp func;
714 auto ty = arrayBox.getType();
715 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
716 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
717 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
718
719 if (eleTy.isF32())
720 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalReal4)>(loc, builder);
721 else if (eleTy.isF64())
722 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalReal8)>(loc, builder);
723 else if (eleTy.isF80())
724 func = fir::runtime::getRuntimeFunc<ForcedMaxvalReal10>(loc, builder);
725 else if (eleTy.isF128())
726 func = fir::runtime::getRuntimeFunc<ForcedMaxvalReal16>(loc, builder);
727 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
728 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger1)>(loc, builder);
729 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
730 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger2)>(loc, builder);
731 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
732 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger4)>(loc, builder);
733 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
734 func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger8)>(loc, builder);
735 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
736 func = fir::runtime::getRuntimeFunc<ForcedMaxvalInteger16>(loc, builder);
737 else
738 fir::intrinsicTypeTODO(builder, eleTy, loc, "MAXVAL");
739
740 auto fTy = func.getFunctionType();
741 auto sourceFile = fir::factory::locationToFilename(builder, loc);
742 auto sourceLine =
743 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
744 auto args = fir::runtime::createArguments(
745 builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
746
747 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
748}
749
750/// Generate call to `MaxvalDim` intrinsic runtime routine. This is the version
751/// that handles any rank array with the dim argument specified.
752void fir::runtime::genMaxvalDim(fir::FirOpBuilder &builder, mlir::Location loc,
753 mlir::Value resultBox, mlir::Value arrayBox,
754 mlir::Value dim, mlir::Value maskBox) {
755 auto func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalDim)>(loc, builder);
756 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
757}
758
759/// Generate call to `MaxvalCharacter` intrinsic runtime routine. This is the
760/// version that handles character arrays of rank 1 and without a DIM argument.
761void fir::runtime::genMaxvalChar(fir::FirOpBuilder &builder, mlir::Location loc,
762 mlir::Value resultBox, mlir::Value arrayBox,
763 mlir::Value maskBox) {
764 auto func =
765 fir::runtime::getRuntimeFunc<mkRTKey(MaxvalCharacter)>(loc, builder);
766 auto fTy = func.getFunctionType();
767 auto sourceFile = fir::factory::locationToFilename(builder, loc);
768 auto sourceLine =
769 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
770 auto args = fir::runtime::createArguments(
771 builder, loc, fTy, resultBox, arrayBox, sourceFile, sourceLine, maskBox);
772 builder.create<fir::CallOp>(loc, func, args);
773}
774
775/// Generate call to `Minloc` intrinsic runtime routine. This is the version
776/// that does not take a dim argument.
777void fir::runtime::genMinloc(fir::FirOpBuilder &builder, mlir::Location loc,
778 mlir::Value resultBox, mlir::Value arrayBox,
779 mlir::Value maskBox, mlir::Value kind,
780 mlir::Value back) {
781 mlir::func::FuncOp func;
782 auto ty = arrayBox.getType();
783 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
784 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
785 fir::factory::CharacterExprHelper charHelper{builder, loc};
786 if (eleTy.isF32())
787 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocReal4)>(loc, builder);
788 else if (eleTy.isF64())
789 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocReal8)>(loc, builder);
790 else if (eleTy.isF80())
791 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocReal10)>(loc, builder);
792 else if (eleTy.isF128())
793 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocReal16)>(loc, builder);
794 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
795 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocInteger1)>(loc, builder);
796 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
797 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocInteger2)>(loc, builder);
798 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
799 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocInteger4)>(loc, builder);
800 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
801 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocInteger8)>(loc, builder);
802 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
803 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocInteger16)>(loc, builder);
804 else if (charHelper.isCharacterScalar(eleTy))
805 func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocCharacter)>(loc, builder);
806 else
807 fir::intrinsicTypeTODO(builder, eleTy, loc, "MINLOC");
808 genReduction4Args(func, builder, loc, resultBox, arrayBox, maskBox, kind,
809 back);
810}
811
812/// Generate call to `MinlocDim` intrinsic runtime routine. This is the version
813/// that takes a dim argument.
814void fir::runtime::genMinlocDim(fir::FirOpBuilder &builder, mlir::Location loc,
815 mlir::Value resultBox, mlir::Value arrayBox,
816 mlir::Value dim, mlir::Value maskBox,
817 mlir::Value kind, mlir::Value back) {
818 auto func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocDim)>(loc, builder);
819 genReduction5Args(func, builder, loc, resultBox, arrayBox, dim, maskBox, kind,
820 back);
821}
822
823/// Generate call to `MinvalDim` intrinsic runtime routine. This is the version
824/// that handles any rank array with the dim argument specified.
825void fir::runtime::genMinvalDim(fir::FirOpBuilder &builder, mlir::Location loc,
826 mlir::Value resultBox, mlir::Value arrayBox,
827 mlir::Value dim, mlir::Value maskBox) {
828 auto func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalDim)>(loc, builder);
829 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
830}
831
832/// Generate call to `MinvalCharacter` intrinsic runtime routine. This is the
833/// version that handles character arrays of rank 1 and without a DIM argument.
834void fir::runtime::genMinvalChar(fir::FirOpBuilder &builder, mlir::Location loc,
835 mlir::Value resultBox, mlir::Value arrayBox,
836 mlir::Value maskBox) {
837 auto func =
838 fir::runtime::getRuntimeFunc<mkRTKey(MinvalCharacter)>(loc, builder);
839 auto fTy = func.getFunctionType();
840 auto sourceFile = fir::factory::locationToFilename(builder, loc);
841 auto sourceLine =
842 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
843 auto args = fir::runtime::createArguments(
844 builder, loc, fTy, resultBox, arrayBox, sourceFile, sourceLine, maskBox);
845 builder.create<fir::CallOp>(loc, func, args);
846}
847
848/// Generate call to `Minval` intrinsic runtime routine. This is the version
849/// that does not take a dim argument.
850mlir::Value fir::runtime::genMinval(fir::FirOpBuilder &builder,
851 mlir::Location loc, mlir::Value arrayBox,
852 mlir::Value maskBox) {
853 mlir::func::FuncOp func;
854 auto ty = arrayBox.getType();
855 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
856 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
857 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
858
859 if (eleTy.isF32())
860 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalReal4)>(loc, builder);
861 else if (eleTy.isF64())
862 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalReal8)>(loc, builder);
863 else if (eleTy.isF80())
864 func = fir::runtime::getRuntimeFunc<ForcedMinvalReal10>(loc, builder);
865 else if (eleTy.isF128())
866 func = fir::runtime::getRuntimeFunc<ForcedMinvalReal16>(loc, builder);
867 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
868 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger1)>(loc, builder);
869 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
870 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger2)>(loc, builder);
871 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
872 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger4)>(loc, builder);
873 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
874 func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger8)>(loc, builder);
875 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
876 func = fir::runtime::getRuntimeFunc<ForcedMinvalInteger16>(loc, builder);
877 else
878 fir::intrinsicTypeTODO(builder, eleTy, loc, "MINVAL");
879
880 auto fTy = func.getFunctionType();
881 auto sourceFile = fir::factory::locationToFilename(builder, loc);
882 auto sourceLine =
883 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
884 auto args = fir::runtime::createArguments(
885 builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
886
887 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
888}
889
890/// Generate call to `Norm2Dim` intrinsic runtime routine. This is the version
891/// that takes a dim argument.
892void fir::runtime::genNorm2Dim(fir::FirOpBuilder &builder, mlir::Location loc,
893 mlir::Value resultBox, mlir::Value arrayBox,
894 mlir::Value dim) {
895 mlir::func::FuncOp func;
896 auto ty = arrayBox.getType();
897 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
898 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
899 if (eleTy.isF128())
900 func = fir::runtime::getRuntimeFunc<ForcedNorm2DimReal16>(loc, builder);
901 else
902 func = fir::runtime::getRuntimeFunc<mkRTKey(Norm2Dim)>(loc, builder);
903 auto fTy = func.getFunctionType();
904 auto sourceFile = fir::factory::locationToFilename(builder, loc);
905 auto sourceLine =
906 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
907 auto args = fir::runtime::createArguments(
908 builder, loc, fTy, resultBox, arrayBox, dim, sourceFile, sourceLine);
909
910 builder.create<fir::CallOp>(loc, func, args);
911}
912
913/// Generate call to `Norm2` intrinsic runtime routine. This is the version
914/// that does not take a dim argument.
915mlir::Value fir::runtime::genNorm2(fir::FirOpBuilder &builder,
916 mlir::Location loc, mlir::Value arrayBox) {
917 mlir::func::FuncOp func;
918 auto ty = arrayBox.getType();
919 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
920 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
921 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
922
923 if (eleTy.isF32())
924 func = fir::runtime::getRuntimeFunc<mkRTKey(Norm2_4)>(loc, builder);
925 else if (eleTy.isF64())
926 func = fir::runtime::getRuntimeFunc<mkRTKey(Norm2_8)>(loc, builder);
927 else if (eleTy.isF80())
928 func = fir::runtime::getRuntimeFunc<ForcedNorm2Real10>(loc, builder);
929 else if (eleTy.isF128())
930 func = fir::runtime::getRuntimeFunc<ForcedNorm2Real16>(loc, builder);
931 else
932 fir::intrinsicTypeTODO(builder, eleTy, loc, "NORM2");
933
934 auto fTy = func.getFunctionType();
935 auto sourceFile = fir::factory::locationToFilename(builder, loc);
936 auto sourceLine =
937 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
938 auto args = fir::runtime::createArguments(builder, loc, fTy, arrayBox,
939 sourceFile, sourceLine, dim);
940
941 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
942}
943
944/// Generate call to `Parity` intrinsic runtime routine. This routine is
945/// specialized for mask arguments with rank == 1.
946mlir::Value fir::runtime::genParity(fir::FirOpBuilder &builder,
947 mlir::Location loc, mlir::Value maskBox,
948 mlir::Value dim) {
949 auto parityFunc = fir::runtime::getRuntimeFunc<mkRTKey(Parity)>(loc, builder);
950 return genSpecial2Args(parityFunc, builder, loc, maskBox, dim);
951}
952
953/// Generate call to `ProductDim` intrinsic runtime routine. This is the version
954/// that handles any rank array with the dim argument specified.
955void fir::runtime::genProductDim(fir::FirOpBuilder &builder, mlir::Location loc,
956 mlir::Value resultBox, mlir::Value arrayBox,
957 mlir::Value dim, mlir::Value maskBox) {
958 auto func = fir::runtime::getRuntimeFunc<mkRTKey(ProductDim)>(loc, builder);
959 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
960}
961
962/// Generate call to `Product` intrinsic runtime routine. This is the version
963/// that does not take a dim argument.
964mlir::Value fir::runtime::genProduct(fir::FirOpBuilder &builder,
965 mlir::Location loc, mlir::Value arrayBox,
966 mlir::Value maskBox,
967 mlir::Value resultBox) {
968 mlir::func::FuncOp func;
969 auto ty = arrayBox.getType();
970 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
971 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
972 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
973
974 if (eleTy.isF32())
975 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductReal4)>(loc, builder);
976 else if (eleTy.isF64())
977 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductReal8)>(loc, builder);
978 else if (eleTy.isF80())
979 func = fir::runtime::getRuntimeFunc<ForcedProductReal10>(loc, builder);
980 else if (eleTy.isF128())
981 func = fir::runtime::getRuntimeFunc<ForcedProductReal16>(loc, builder);
982 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
983 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger1)>(loc, builder);
984 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
985 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger2)>(loc, builder);
986 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
987 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger4)>(loc, builder);
988 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
989 func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger8)>(loc, builder);
990 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
991 func = fir::runtime::getRuntimeFunc<ForcedProductInteger16>(loc, builder);
992 else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
993 func =
994 fir::runtime::getRuntimeFunc<mkRTKey(CppProductComplex4)>(loc, builder);
995 else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
996 func =
997 fir::runtime::getRuntimeFunc<mkRTKey(CppProductComplex8)>(loc, builder);
998 else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
999 func = fir::runtime::getRuntimeFunc<ForcedProductComplex10>(loc, builder);
1000 else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
1001 func = fir::runtime::getRuntimeFunc<ForcedProductComplex16>(loc, builder);
1002 else
1003 fir::intrinsicTypeTODO(builder, eleTy, loc, "PRODUCT");
1004
1005 auto fTy = func.getFunctionType();
1006 auto sourceFile = fir::factory::locationToFilename(builder, loc);
1007 if (fir::isa_complex(eleTy)) {
1008 auto sourceLine =
1009 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
1010 auto args =
1011 fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox,
1012 sourceFile, sourceLine, dim, maskBox);
1013 builder.create<fir::CallOp>(loc, func, args);
1014 return resultBox;
1015 }
1016
1017 auto sourceLine =
1018 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
1019 auto args = fir::runtime::createArguments(
1020 builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
1021
1022 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
1023}
1024
1025/// Generate call to `DotProduct` intrinsic runtime routine.
1026mlir::Value fir::runtime::genDotProduct(fir::FirOpBuilder &builder,
1027 mlir::Location loc,
1028 mlir::Value vectorABox,
1029 mlir::Value vectorBBox,
1030 mlir::Value resultBox) {
1031 mlir::func::FuncOp func;
1032 // For complex data types, resultBox is !fir.ref<!fir.complex<N>>,
1033 // otherwise it is !fir.box<T>.
1034 auto ty = resultBox.getType();
1035 auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
1036
1037 if (eleTy.isF32())
1038 func = fir::runtime::getRuntimeFunc<mkRTKey(DotProductReal4)>(loc, builder);
1039 else if (eleTy.isF64())
1040 func = fir::runtime::getRuntimeFunc<mkRTKey(DotProductReal8)>(loc, builder);
1041 else if (eleTy.isF80())
1042 func = fir::runtime::getRuntimeFunc<ForcedDotProductReal10>(loc, builder);
1043 else if (eleTy.isF128())
1044 func = fir::runtime::getRuntimeFunc<ForcedDotProductReal16>(loc, builder);
1045 else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
1046 func = fir::runtime::getRuntimeFunc<mkRTKey(CppDotProductComplex4)>(
1047 loc, builder);
1048 else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
1049 func = fir::runtime::getRuntimeFunc<mkRTKey(CppDotProductComplex8)>(
1050 loc, builder);
1051 else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
1052 func =
1053 fir::runtime::getRuntimeFunc<ForcedDotProductComplex10>(loc, builder);
1054 else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
1055 func =
1056 fir::runtime::getRuntimeFunc<ForcedDotProductComplex16>(loc, builder);
1057 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
1058 func =
1059 fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger1)>(loc, builder);
1060 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
1061 func =
1062 fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger2)>(loc, builder);
1063 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
1064 func =
1065 fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger4)>(loc, builder);
1066 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
1067 func =
1068 fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger8)>(loc, builder);
1069 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
1070 func =
1071 fir::runtime::getRuntimeFunc<ForcedDotProductInteger16>(loc, builder);
1072 else if (eleTy.isa<fir::LogicalType>())
1073 func =
1074 fir::runtime::getRuntimeFunc<mkRTKey(DotProductLogical)>(loc, builder);
1075 else
1076 fir::intrinsicTypeTODO(builder, eleTy, loc, "DOTPRODUCT");
1077
1078 auto fTy = func.getFunctionType();
1079 auto sourceFile = fir::factory::locationToFilename(builder, loc);
1080
1081 if (fir::isa_complex(eleTy)) {
1082 auto sourceLine =
1083 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
1084 auto args =
1085 fir::runtime::createArguments(builder, loc, fTy, resultBox, vectorABox,
1086 vectorBBox, sourceFile, sourceLine);
1087 builder.create<fir::CallOp>(loc, func, args);
1088 return resultBox;
1089 }
1090
1091 auto sourceLine =
1092 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
1093 auto args = fir::runtime::createArguments(builder, loc, fTy, vectorABox,
1094 vectorBBox, sourceFile, sourceLine);
1095 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
1096}
1097/// Generate call to `SumDim` intrinsic runtime routine. This is the version
1098/// that handles any rank array with the dim argument specified.
1099void fir::runtime::genSumDim(fir::FirOpBuilder &builder, mlir::Location loc,
1100 mlir::Value resultBox, mlir::Value arrayBox,
1101 mlir::Value dim, mlir::Value maskBox) {
1102 auto func = fir::runtime::getRuntimeFunc<mkRTKey(SumDim)>(loc, builder);
1103 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
1104}
1105
1106/// Generate call to `Sum` intrinsic runtime routine. This is the version
1107/// that does not take a dim argument.
1108mlir::Value fir::runtime::genSum(fir::FirOpBuilder &builder, mlir::Location loc,
1109 mlir::Value arrayBox, mlir::Value maskBox,
1110 mlir::Value resultBox) {
1111 mlir::func::FuncOp func;
1112 auto ty = arrayBox.getType();
1113 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
1114 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
1115 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
1116
1117 if (eleTy.isF32())
1118 func = fir::runtime::getRuntimeFunc<mkRTKey(SumReal4)>(loc, builder);
1119 else if (eleTy.isF64())
1120 func = fir::runtime::getRuntimeFunc<mkRTKey(SumReal8)>(loc, builder);
1121 else if (eleTy.isF80())
1122 func = fir::runtime::getRuntimeFunc<ForcedSumReal10>(loc, builder);
1123 else if (eleTy.isF128())
1124 func = fir::runtime::getRuntimeFunc<ForcedSumReal16>(loc, builder);
1125 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
1126 func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger1)>(loc, builder);
1127 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
1128 func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger2)>(loc, builder);
1129 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
1130 func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger4)>(loc, builder);
1131 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
1132 func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger8)>(loc, builder);
1133 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
1134 func = fir::runtime::getRuntimeFunc<ForcedSumInteger16>(loc, builder);
1135 else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
1136 func = fir::runtime::getRuntimeFunc<mkRTKey(CppSumComplex4)>(loc, builder);
1137 else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
1138 func = fir::runtime::getRuntimeFunc<mkRTKey(CppSumComplex8)>(loc, builder);
1139 else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
1140 func = fir::runtime::getRuntimeFunc<ForcedSumComplex10>(loc, builder);
1141 else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
1142 func = fir::runtime::getRuntimeFunc<ForcedSumComplex16>(loc, builder);
1143 else
1144 fir::intrinsicTypeTODO(builder, eleTy, loc, "SUM");
1145
1146 auto fTy = func.getFunctionType();
1147 auto sourceFile = fir::factory::locationToFilename(builder, loc);
1148 if (fir::isa_complex(eleTy)) {
1149 auto sourceLine =
1150 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
1151 auto args =
1152 fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox,
1153 sourceFile, sourceLine, dim, maskBox);
1154 builder.create<fir::CallOp>(loc, func, args);
1155 return resultBox;
1156 }
1157
1158 auto sourceLine =
1159 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
1160 auto args = fir::runtime::createArguments(
1161 builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
1162
1163 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
1164}
1165
1166// The IAll, IAny and IParity intrinsics have essentially the same
1167// implementation. This macro will generate the function body given the
1168// instrinsic name.
1169#define GEN_IALL_IANY_IPARITY(F) \
1170 mlir::Value fir::runtime::JOIN2(gen, F)( \
1171 fir::FirOpBuilder & builder, mlir::Location loc, mlir::Value arrayBox, \
1172 mlir::Value maskBox, mlir::Value resultBox) { \
1173 mlir::func::FuncOp func; \
1174 auto ty = arrayBox.getType(); \
1175 auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty); \
1176 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy(); \
1177 auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0); \
1178 \
1179 if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1))) \
1180 func = fir::runtime::getRuntimeFunc<mkRTKey(JOIN2(F, 1))>(loc, builder); \
1181 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2))) \
1182 func = fir::runtime::getRuntimeFunc<mkRTKey(JOIN2(F, 2))>(loc, builder); \
1183 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4))) \
1184 func = fir::runtime::getRuntimeFunc<mkRTKey(JOIN2(F, 4))>(loc, builder); \
1185 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8))) \
1186 func = fir::runtime::getRuntimeFunc<mkRTKey(JOIN2(F, 8))>(loc, builder); \
1187 else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16))) \
1188 func = fir::runtime::getRuntimeFunc<JOIN3(Forced, F, 16)>(loc, builder); \
1189 else \
1190 fir::emitFatalError(loc, "invalid type in " STRINGIFY(F)); \
1191 \
1192 auto fTy = func.getFunctionType(); \
1193 auto sourceFile = fir::factory::locationToFilename(builder, loc); \
1194 auto sourceLine = \
1195 fir::factory::locationToLineNo(builder, loc, fTy.getInput(2)); \
1196 auto args = fir::runtime::createArguments( \
1197 builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox); \
1198 \
1199 return builder.create<fir::CallOp>(loc, func, args).getResult(0); \
1200 }
1201
1202/// Generate call to `IAllDim` intrinsic runtime routine. This is the version
1203/// that handles any rank array with the dim argument specified.
1204void fir::runtime::genIAllDim(fir::FirOpBuilder &builder, mlir::Location loc,
1205 mlir::Value resultBox, mlir::Value arrayBox,
1206 mlir::Value dim, mlir::Value maskBox) {
1207 auto func = fir::runtime::getRuntimeFunc<mkRTKey(IAllDim)>(loc, builder);
1208 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
1209}
1210
1211/// Generate call to `IAll` intrinsic runtime routine. This is the version
1212/// that does not take a dim argument.
1213GEN_IALL_IANY_IPARITY(IAll)
1214
1215/// Generate call to `IAnyDim` intrinsic runtime routine. This is the version
1216/// that handles any rank array with the dim argument specified.
1217void fir::runtime::genIAnyDim(fir::FirOpBuilder &builder, mlir::Location loc,
1218 mlir::Value resultBox, mlir::Value arrayBox,
1219 mlir::Value dim, mlir::Value maskBox) {
1220 auto func = fir::runtime::getRuntimeFunc<mkRTKey(IAnyDim)>(loc, builder);
1221 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
1222}
1223
1224/// Generate call to `IAny` intrinsic runtime routine. This is the version
1225/// that does not take a dim argument.
1226GEN_IALL_IANY_IPARITY(IAny)
1227
1228/// Generate call to `IParityDim` intrinsic runtime routine. This is the version
1229/// that handles any rank array with the dim argument specified.
1230void fir::runtime::genIParityDim(fir::FirOpBuilder &builder, mlir::Location loc,
1231 mlir::Value resultBox, mlir::Value arrayBox,
1232 mlir::Value dim, mlir::Value maskBox) {
1233 auto func = fir::runtime::getRuntimeFunc<mkRTKey(IParityDim)>(loc, builder);
1234 genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
1235}
1236
1237/// Generate call to `IParity` intrinsic runtime routine. This is the version
1238/// that does not take a dim argument.
1239GEN_IALL_IANY_IPARITY(IParity)
1240

source code of flang/lib/Optimizer/Builder/Runtime/Reduction.cpp