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/Builder/Todo.h"
15 #include "flang/Runtime/reduction.h"
16 #include "mlir/Dialect/Func/IR/FuncOps.h"
17 
18 using namespace Fortran::runtime;
19 
20 /// Placeholder for real*10 version of Maxval Intrinsic
21 struct ForcedMaxvalReal10 {
22   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MaxvalReal10));
getTypeModelForcedMaxvalReal1023   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
24     return [](mlir::MLIRContext *ctx) {
25       auto ty = mlir::FloatType::getF80(ctx);
26       auto boxTy =
27           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
28       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
29       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
30       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
31                                      {ty});
32     };
33   }
34 };
35 
36 /// Placeholder for real*16 version of Maxval Intrinsic
37 struct ForcedMaxvalReal16 {
38   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MaxvalReal16));
getTypeModelForcedMaxvalReal1639   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
40     return [](mlir::MLIRContext *ctx) {
41       auto ty = mlir::FloatType::getF128(ctx);
42       auto boxTy =
43           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
44       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
45       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
46       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
47                                      {ty});
48     };
49   }
50 };
51 
52 /// Placeholder for integer*16 version of Maxval Intrinsic
53 struct ForcedMaxvalInteger16 {
54   static constexpr const char *name =
55       ExpandAndQuoteKey(RTNAME(MaxvalInteger16));
getTypeModelForcedMaxvalInteger1656   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
57     return [](mlir::MLIRContext *ctx) {
58       auto ty = mlir::IntegerType::get(ctx, 128);
59       auto boxTy =
60           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
61       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
62       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
63       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
64                                      {ty});
65     };
66   }
67 };
68 
69 /// Placeholder for real*10 version of Minval Intrinsic
70 struct ForcedMinvalReal10 {
71   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal10));
getTypeModelForcedMinvalReal1072   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
73     return [](mlir::MLIRContext *ctx) {
74       auto ty = mlir::FloatType::getF80(ctx);
75       auto boxTy =
76           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
77       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
78       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
79       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
80                                      {ty});
81     };
82   }
83 };
84 
85 /// Placeholder for real*16 version of Minval Intrinsic
86 struct ForcedMinvalReal16 {
87   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal16));
getTypeModelForcedMinvalReal1688   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
89     return [](mlir::MLIRContext *ctx) {
90       auto ty = mlir::FloatType::getF128(ctx);
91       auto boxTy =
92           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
93       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
94       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
95       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
96                                      {ty});
97     };
98   }
99 };
100 
101 /// Placeholder for integer*16 version of Minval Intrinsic
102 struct ForcedMinvalInteger16 {
103   static constexpr const char *name =
104       ExpandAndQuoteKey(RTNAME(MinvalInteger16));
getTypeModelForcedMinvalInteger16105   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
106     return [](mlir::MLIRContext *ctx) {
107       auto ty = mlir::IntegerType::get(ctx, 128);
108       auto boxTy =
109           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
110       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
111       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
112       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
113                                      {ty});
114     };
115   }
116 };
117 
118 /// Placeholder for real*10 version of Product Intrinsic
119 struct ForcedProductReal10 {
120   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ProductReal10));
getTypeModelForcedProductReal10121   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
122     return [](mlir::MLIRContext *ctx) {
123       auto ty = mlir::FloatType::getF80(ctx);
124       auto boxTy =
125           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
126       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
127       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
128       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
129                                      {ty});
130     };
131   }
132 };
133 
134 /// Placeholder for real*16 version of Product Intrinsic
135 struct ForcedProductReal16 {
136   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ProductReal16));
getTypeModelForcedProductReal16137   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
138     return [](mlir::MLIRContext *ctx) {
139       auto ty = mlir::FloatType::getF128(ctx);
140       auto boxTy =
141           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
142       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
143       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
144       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
145                                      {ty});
146     };
147   }
148 };
149 
150 /// Placeholder for integer*16 version of Product Intrinsic
151 struct ForcedProductInteger16 {
152   static constexpr const char *name =
153       ExpandAndQuoteKey(RTNAME(ProductInteger16));
getTypeModelForcedProductInteger16154   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
155     return [](mlir::MLIRContext *ctx) {
156       auto ty = mlir::IntegerType::get(ctx, 128);
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(ctx, {boxTy, strTy, intTy, intTy, boxTy},
162                                      {ty});
163     };
164   }
165 };
166 
167 /// Placeholder for complex(10) version of Product Intrinsic
168 struct ForcedProductComplex10 {
169   static constexpr const char *name =
170       ExpandAndQuoteKey(RTNAME(CppProductComplex10));
getTypeModelForcedProductComplex10171   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
172     return [](mlir::MLIRContext *ctx) {
173       auto ty = mlir::ComplexType::get(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       auto resTy = fir::ReferenceType::get(ty);
179       return mlir::FunctionType::get(
180           ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
181     };
182   }
183 };
184 
185 /// Placeholder for complex(16) version of Product Intrinsic
186 struct ForcedProductComplex16 {
187   static constexpr const char *name =
188       ExpandAndQuoteKey(RTNAME(CppProductComplex16));
getTypeModelForcedProductComplex16189   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
190     return [](mlir::MLIRContext *ctx) {
191       auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
192       auto boxTy =
193           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
194       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
195       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
196       auto resTy = fir::ReferenceType::get(ty);
197       return mlir::FunctionType::get(
198           ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
199     };
200   }
201 };
202 
203 /// Placeholder for real*10 version of DotProduct Intrinsic
204 struct ForcedDotProductReal10 {
205   static constexpr const char *name =
206       ExpandAndQuoteKey(RTNAME(DotProductReal10));
getTypeModelForcedDotProductReal10207   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
208     return [](mlir::MLIRContext *ctx) {
209       auto ty = mlir::FloatType::getF80(ctx);
210       auto boxTy =
211           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
212       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
213       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
214       return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
215     };
216   }
217 };
218 
219 /// Placeholder for real*16 version of DotProduct Intrinsic
220 struct ForcedDotProductReal16 {
221   static constexpr const char *name =
222       ExpandAndQuoteKey(RTNAME(DotProductReal16));
getTypeModelForcedDotProductReal16223   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
224     return [](mlir::MLIRContext *ctx) {
225       auto ty = mlir::FloatType::getF128(ctx);
226       auto boxTy =
227           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
228       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
229       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
230       return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
231     };
232   }
233 };
234 
235 /// Placeholder for complex(10) version of DotProduct Intrinsic
236 struct ForcedDotProductComplex10 {
237   static constexpr const char *name =
238       ExpandAndQuoteKey(RTNAME(CppDotProductComplex10));
getTypeModelForcedDotProductComplex10239   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
240     return [](mlir::MLIRContext *ctx) {
241       auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(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(ctx, {resTy, boxTy, boxTy, strTy, intTy},
248                                      {});
249     };
250   }
251 };
252 
253 /// Placeholder for complex(16) version of DotProduct Intrinsic
254 struct ForcedDotProductComplex16 {
255   static constexpr const char *name =
256       ExpandAndQuoteKey(RTNAME(CppDotProductComplex16));
getTypeModelForcedDotProductComplex16257   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
258     return [](mlir::MLIRContext *ctx) {
259       auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(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       auto resTy = fir::ReferenceType::get(ty);
265       return mlir::FunctionType::get(ctx, {resTy, boxTy, boxTy, strTy, intTy},
266                                      {});
267     };
268   }
269 };
270 
271 /// Placeholder for integer*16 version of DotProduct Intrinsic
272 struct ForcedDotProductInteger16 {
273   static constexpr const char *name =
274       ExpandAndQuoteKey(RTNAME(DotProductInteger16));
getTypeModelForcedDotProductInteger16275   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
276     return [](mlir::MLIRContext *ctx) {
277       auto ty = mlir::IntegerType::get(ctx, 128);
278       auto boxTy =
279           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
280       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
281       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
282       return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
283     };
284   }
285 };
286 
287 /// Placeholder for real*10 version of Sum Intrinsic
288 struct ForcedSumReal10 {
289   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal10));
getTypeModelForcedSumReal10290   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
291     return [](mlir::MLIRContext *ctx) {
292       auto ty = mlir::FloatType::getF80(ctx);
293       auto boxTy =
294           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
295       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
296       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
297       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
298                                      {ty});
299     };
300   }
301 };
302 
303 /// Placeholder for real*16 version of Sum Intrinsic
304 struct ForcedSumReal16 {
305   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal16));
getTypeModelForcedSumReal16306   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
307     return [](mlir::MLIRContext *ctx) {
308       auto ty = mlir::FloatType::getF128(ctx);
309       auto boxTy =
310           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
311       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
312       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
313       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
314                                      {ty});
315     };
316   }
317 };
318 
319 /// Placeholder for integer*16 version of Sum Intrinsic
320 struct ForcedSumInteger16 {
321   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumInteger16));
getTypeModelForcedSumInteger16322   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
323     return [](mlir::MLIRContext *ctx) {
324       auto ty = mlir::IntegerType::get(ctx, 128);
325       auto boxTy =
326           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
327       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
328       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
329       return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
330                                      {ty});
331     };
332   }
333 };
334 
335 /// Placeholder for complex(10) version of Sum Intrinsic
336 struct ForcedSumComplex10 {
337   static constexpr const char *name =
338       ExpandAndQuoteKey(RTNAME(CppSumComplex10));
getTypeModelForcedSumComplex10339   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
340     return [](mlir::MLIRContext *ctx) {
341       auto ty = mlir::ComplexType::get(mlir::FloatType::getF80(ctx));
342       auto boxTy =
343           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
344       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
345       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
346       auto resTy = fir::ReferenceType::get(ty);
347       return mlir::FunctionType::get(
348           ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
349     };
350   }
351 };
352 
353 /// Placeholder for complex(16) version of Sum Intrinsic
354 struct ForcedSumComplex16 {
355   static constexpr const char *name =
356       ExpandAndQuoteKey(RTNAME(CppSumComplex16));
getTypeModelForcedSumComplex16357   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
358     return [](mlir::MLIRContext *ctx) {
359       auto ty = mlir::ComplexType::get(mlir::FloatType::getF128(ctx));
360       auto boxTy =
361           fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
362       auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
363       auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
364       auto resTy = fir::ReferenceType::get(ty);
365       return mlir::FunctionType::get(
366           ctx, {resTy, boxTy, strTy, intTy, intTy, boxTy}, {});
367     };
368   }
369 };
370 
371 /// Generate call to specialized runtime function that takes a mask and
372 /// dim argument. The All, Any, and Count intrinsics use this pattern.
373 template <typename FN>
genSpecial2Args(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value maskBox,mlir::Value dim)374 mlir::Value genSpecial2Args(FN func, fir::FirOpBuilder &builder,
375                             mlir::Location loc, mlir::Value maskBox,
376                             mlir::Value dim) {
377   auto fTy = func.getFunctionType();
378   auto sourceFile = fir::factory::locationToFilename(builder, loc);
379   auto sourceLine =
380       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
381   auto args = fir::runtime::createArguments(builder, loc, fTy, maskBox,
382                                             sourceFile, sourceLine, dim);
383   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
384 }
385 
386 /// Generate calls to reduction intrinsics such as All and Any.
387 /// These are the descriptor based implementations that take two
388 /// arguments (mask, dim).
389 template <typename FN>
genReduction2Args(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value maskBox,mlir::Value dim)390 static void genReduction2Args(FN func, fir::FirOpBuilder &builder,
391                               mlir::Location loc, mlir::Value resultBox,
392                               mlir::Value maskBox, mlir::Value dim) {
393   auto fTy = func.getFunctionType();
394   auto sourceFile = fir::factory::locationToFilename(builder, loc);
395   auto sourceLine =
396       fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
397   auto args = fir::runtime::createArguments(
398       builder, loc, fTy, resultBox, maskBox, dim, sourceFile, sourceLine);
399   builder.create<fir::CallOp>(loc, func, args);
400 }
401 
402 /// Generate calls to reduction intrinsics such as Maxval and Minval.
403 /// These take arguments such as (array, dim, mask).
404 template <typename FN>
genReduction3Args(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox)405 static void genReduction3Args(FN func, fir::FirOpBuilder &builder,
406                               mlir::Location loc, mlir::Value resultBox,
407                               mlir::Value arrayBox, mlir::Value dim,
408                               mlir::Value maskBox) {
409 
410   auto fTy = func.getFunctionType();
411   auto sourceFile = fir::factory::locationToFilename(builder, loc);
412   auto sourceLine =
413       fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
414   auto args =
415       fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox, dim,
416                                     sourceFile, sourceLine, maskBox);
417   builder.create<fir::CallOp>(loc, func, args);
418 }
419 
420 /// Generate calls to reduction intrinsics such as Maxloc and Minloc.
421 /// These take arguments such as (array, mask, kind, back).
422 template <typename FN>
genReduction4Args(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value maskBox,mlir::Value kind,mlir::Value back)423 static void genReduction4Args(FN func, fir::FirOpBuilder &builder,
424                               mlir::Location loc, mlir::Value resultBox,
425                               mlir::Value arrayBox, mlir::Value maskBox,
426                               mlir::Value kind, mlir::Value back) {
427   auto fTy = func.getFunctionType();
428   auto sourceFile = fir::factory::locationToFilename(builder, loc);
429   auto sourceLine =
430       fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
431   auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
432                                             arrayBox, kind, sourceFile,
433                                             sourceLine, maskBox, back);
434   builder.create<fir::CallOp>(loc, func, args);
435 }
436 
437 /// Generate calls to reduction intrinsics such as Maxloc and Minloc.
438 /// These take arguments such as (array, dim, mask, kind, back).
439 template <typename FN>
440 static void
genReduction5Args(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox,mlir::Value kind,mlir::Value back)441 genReduction5Args(FN func, fir::FirOpBuilder &builder, mlir::Location loc,
442                   mlir::Value resultBox, mlir::Value arrayBox, mlir::Value dim,
443                   mlir::Value maskBox, mlir::Value kind, mlir::Value back) {
444   auto fTy = func.getFunctionType();
445   auto sourceFile = fir::factory::locationToFilename(builder, loc);
446   auto sourceLine =
447       fir::factory::locationToLineNo(builder, loc, fTy.getInput(5));
448   auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
449                                             arrayBox, kind, dim, sourceFile,
450                                             sourceLine, maskBox, back);
451   builder.create<fir::CallOp>(loc, func, args);
452 }
453 
454 /// Generate call to `AllDim` runtime routine.
455 /// This calls the descriptor based runtime call implementation of the `all`
456 /// intrinsic.
genAllDescriptor(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value maskBox,mlir::Value dim)457 void fir::runtime::genAllDescriptor(fir::FirOpBuilder &builder,
458                                     mlir::Location loc, mlir::Value resultBox,
459                                     mlir::Value maskBox, mlir::Value dim) {
460   auto allFunc = fir::runtime::getRuntimeFunc<mkRTKey(AllDim)>(loc, builder);
461   genReduction2Args(allFunc, builder, loc, resultBox, maskBox, dim);
462 }
463 
464 /// Generate call to `AnyDim` runtime routine.
465 /// This calls the descriptor based runtime call implementation of the `any`
466 /// intrinsic.
genAnyDescriptor(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value maskBox,mlir::Value dim)467 void fir::runtime::genAnyDescriptor(fir::FirOpBuilder &builder,
468                                     mlir::Location loc, mlir::Value resultBox,
469                                     mlir::Value maskBox, mlir::Value dim) {
470   auto anyFunc = fir::runtime::getRuntimeFunc<mkRTKey(AnyDim)>(loc, builder);
471   genReduction2Args(anyFunc, builder, loc, resultBox, maskBox, dim);
472 }
473 
474 /// Generate call to `All` intrinsic runtime routine. This routine is
475 /// specialized for mask arguments with rank == 1.
genAll(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value maskBox,mlir::Value dim)476 mlir::Value fir::runtime::genAll(fir::FirOpBuilder &builder, mlir::Location loc,
477                                  mlir::Value maskBox, mlir::Value dim) {
478   auto allFunc = fir::runtime::getRuntimeFunc<mkRTKey(All)>(loc, builder);
479   return genSpecial2Args(allFunc, builder, loc, maskBox, dim);
480 }
481 
482 /// Generate call to `Any` intrinsic runtime routine. This routine is
483 /// specialized for mask arguments with rank == 1.
genAny(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value maskBox,mlir::Value dim)484 mlir::Value fir::runtime::genAny(fir::FirOpBuilder &builder, mlir::Location loc,
485                                  mlir::Value maskBox, mlir::Value dim) {
486   auto anyFunc = fir::runtime::getRuntimeFunc<mkRTKey(Any)>(loc, builder);
487   return genSpecial2Args(anyFunc, builder, loc, maskBox, dim);
488 }
489 
490 /// Generate call to `Count` runtime routine. This routine is a specialized
491 /// version when mask is a rank one array or the dim argument is not
492 /// specified by the user.
genCount(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value maskBox,mlir::Value dim)493 mlir::Value fir::runtime::genCount(fir::FirOpBuilder &builder,
494                                    mlir::Location loc, mlir::Value maskBox,
495                                    mlir::Value dim) {
496   auto countFunc = fir::runtime::getRuntimeFunc<mkRTKey(Count)>(loc, builder);
497   return genSpecial2Args(countFunc, builder, loc, maskBox, dim);
498 }
499 
500 /// Generate call to general `CountDim` runtime routine. This routine has a
501 /// descriptor result.
genCountDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value maskBox,mlir::Value dim,mlir::Value kind)502 void fir::runtime::genCountDim(fir::FirOpBuilder &builder, mlir::Location loc,
503                                mlir::Value resultBox, mlir::Value maskBox,
504                                mlir::Value dim, mlir::Value kind) {
505   auto func = fir::runtime::getRuntimeFunc<mkRTKey(CountDim)>(loc, builder);
506   auto fTy = func.getFunctionType();
507   auto sourceFile = fir::factory::locationToFilename(builder, loc);
508   auto sourceLine =
509       fir::factory::locationToLineNo(builder, loc, fTy.getInput(5));
510   auto args = fir::runtime::createArguments(
511       builder, loc, fTy, resultBox, maskBox, dim, kind, sourceFile, sourceLine);
512   builder.create<fir::CallOp>(loc, func, args);
513 }
514 
515 /// Generate call to `Maxloc` intrinsic runtime routine. This is the version
516 /// that does not take a dim argument.
genMaxloc(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value maskBox,mlir::Value kind,mlir::Value back)517 void fir::runtime::genMaxloc(fir::FirOpBuilder &builder, mlir::Location loc,
518                              mlir::Value resultBox, mlir::Value arrayBox,
519                              mlir::Value maskBox, mlir::Value kind,
520                              mlir::Value back) {
521   auto func = fir::runtime::getRuntimeFunc<mkRTKey(Maxloc)>(loc, builder);
522   genReduction4Args(func, builder, loc, resultBox, arrayBox, maskBox, kind,
523                     back);
524 }
525 
526 /// Generate call to `MaxlocDim` intrinsic runtime routine. This is the version
527 /// that takes a dim argument.
genMaxlocDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox,mlir::Value kind,mlir::Value back)528 void fir::runtime::genMaxlocDim(fir::FirOpBuilder &builder, mlir::Location loc,
529                                 mlir::Value resultBox, mlir::Value arrayBox,
530                                 mlir::Value dim, mlir::Value maskBox,
531                                 mlir::Value kind, mlir::Value back) {
532   auto func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocDim)>(loc, builder);
533   genReduction5Args(func, builder, loc, resultBox, arrayBox, dim, maskBox, kind,
534                     back);
535 }
536 
537 /// Generate call to `Maxval` intrinsic runtime routine. This is the version
538 /// that does not take a dim argument.
genMaxval(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value arrayBox,mlir::Value maskBox)539 mlir::Value fir::runtime::genMaxval(fir::FirOpBuilder &builder,
540                                     mlir::Location loc, mlir::Value arrayBox,
541                                     mlir::Value maskBox) {
542   mlir::func::FuncOp func;
543   auto ty = arrayBox.getType();
544   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
545   auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
546   auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
547 
548   if (eleTy.isF16() || eleTy.isBF16())
549     TODO(loc, "half-precision MAXVAL");
550   else if (eleTy.isF32())
551     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalReal4)>(loc, builder);
552   else if (eleTy.isF64())
553     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalReal8)>(loc, builder);
554   else if (eleTy.isF80())
555     func = fir::runtime::getRuntimeFunc<ForcedMaxvalReal10>(loc, builder);
556   else if (eleTy.isF128())
557     func = fir::runtime::getRuntimeFunc<ForcedMaxvalReal16>(loc, builder);
558   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
559     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger1)>(loc, builder);
560   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
561     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger2)>(loc, builder);
562   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
563     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger4)>(loc, builder);
564   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
565     func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalInteger8)>(loc, builder);
566   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
567     func = fir::runtime::getRuntimeFunc<ForcedMaxvalInteger16>(loc, builder);
568   else
569     fir::emitFatalError(loc, "invalid type in MAXVAL");
570 
571   auto fTy = func.getFunctionType();
572   auto sourceFile = fir::factory::locationToFilename(builder, loc);
573   auto sourceLine =
574       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
575   auto args = fir::runtime::createArguments(
576       builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
577 
578   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
579 }
580 
581 /// Generate call to `MaxvalDim` intrinsic runtime routine. This is the version
582 /// that handles any rank array with the dim argument specified.
genMaxvalDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox)583 void fir::runtime::genMaxvalDim(fir::FirOpBuilder &builder, mlir::Location loc,
584                                 mlir::Value resultBox, mlir::Value arrayBox,
585                                 mlir::Value dim, mlir::Value maskBox) {
586   auto func = fir::runtime::getRuntimeFunc<mkRTKey(MaxvalDim)>(loc, builder);
587   genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
588 }
589 
590 /// Generate call to `MaxvalCharacter` intrinsic runtime routine. This is the
591 /// version that handles character arrays of rank 1 and without a DIM argument.
genMaxvalChar(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value maskBox)592 void fir::runtime::genMaxvalChar(fir::FirOpBuilder &builder, mlir::Location loc,
593                                  mlir::Value resultBox, mlir::Value arrayBox,
594                                  mlir::Value maskBox) {
595   auto func =
596       fir::runtime::getRuntimeFunc<mkRTKey(MaxvalCharacter)>(loc, builder);
597   auto fTy = func.getFunctionType();
598   auto sourceFile = fir::factory::locationToFilename(builder, loc);
599   auto sourceLine =
600       fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
601   auto args = fir::runtime::createArguments(
602       builder, loc, fTy, resultBox, arrayBox, sourceFile, sourceLine, maskBox);
603   builder.create<fir::CallOp>(loc, func, args);
604 }
605 
606 /// Generate call to `Minloc` intrinsic runtime routine. This is the version
607 /// that does not take a dim argument.
genMinloc(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value maskBox,mlir::Value kind,mlir::Value back)608 void fir::runtime::genMinloc(fir::FirOpBuilder &builder, mlir::Location loc,
609                              mlir::Value resultBox, mlir::Value arrayBox,
610                              mlir::Value maskBox, mlir::Value kind,
611                              mlir::Value back) {
612   auto func = fir::runtime::getRuntimeFunc<mkRTKey(Minloc)>(loc, builder);
613   genReduction4Args(func, builder, loc, resultBox, arrayBox, maskBox, kind,
614                     back);
615 }
616 
617 /// Generate call to `MinlocDim` intrinsic runtime routine. This is the version
618 /// that takes a dim argument.
genMinlocDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox,mlir::Value kind,mlir::Value back)619 void fir::runtime::genMinlocDim(fir::FirOpBuilder &builder, mlir::Location loc,
620                                 mlir::Value resultBox, mlir::Value arrayBox,
621                                 mlir::Value dim, mlir::Value maskBox,
622                                 mlir::Value kind, mlir::Value back) {
623   auto func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocDim)>(loc, builder);
624   genReduction5Args(func, builder, loc, resultBox, arrayBox, dim, maskBox, kind,
625                     back);
626 }
627 
628 /// Generate call to `MinvalDim` intrinsic runtime routine. This is the version
629 /// that handles any rank array with the dim argument specified.
genMinvalDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox)630 void fir::runtime::genMinvalDim(fir::FirOpBuilder &builder, mlir::Location loc,
631                                 mlir::Value resultBox, mlir::Value arrayBox,
632                                 mlir::Value dim, mlir::Value maskBox) {
633   auto func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalDim)>(loc, builder);
634   genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
635 }
636 
637 /// Generate call to `MinvalCharacter` intrinsic runtime routine. This is the
638 /// version that handles character arrays of rank 1 and without a DIM argument.
genMinvalChar(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value maskBox)639 void fir::runtime::genMinvalChar(fir::FirOpBuilder &builder, mlir::Location loc,
640                                  mlir::Value resultBox, mlir::Value arrayBox,
641                                  mlir::Value maskBox) {
642   auto func =
643       fir::runtime::getRuntimeFunc<mkRTKey(MinvalCharacter)>(loc, builder);
644   auto fTy = func.getFunctionType();
645   auto sourceFile = fir::factory::locationToFilename(builder, loc);
646   auto sourceLine =
647       fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
648   auto args = fir::runtime::createArguments(
649       builder, loc, fTy, resultBox, arrayBox, sourceFile, sourceLine, maskBox);
650   builder.create<fir::CallOp>(loc, func, args);
651 }
652 
653 /// Generate call to `Minval` intrinsic runtime routine. This is the version
654 /// that does not take a dim argument.
genMinval(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value arrayBox,mlir::Value maskBox)655 mlir::Value fir::runtime::genMinval(fir::FirOpBuilder &builder,
656                                     mlir::Location loc, mlir::Value arrayBox,
657                                     mlir::Value maskBox) {
658   mlir::func::FuncOp func;
659   auto ty = arrayBox.getType();
660   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
661   auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
662   auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
663 
664   if (eleTy.isF16() || eleTy.isBF16())
665     TODO(loc, "half-precision MINVAL");
666   else if (eleTy.isF32())
667     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalReal4)>(loc, builder);
668   else if (eleTy.isF64())
669     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalReal8)>(loc, builder);
670   else if (eleTy.isF80())
671     func = fir::runtime::getRuntimeFunc<ForcedMinvalReal10>(loc, builder);
672   else if (eleTy.isF128())
673     func = fir::runtime::getRuntimeFunc<ForcedMinvalReal16>(loc, builder);
674   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
675     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger1)>(loc, builder);
676   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
677     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger2)>(loc, builder);
678   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
679     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger4)>(loc, builder);
680   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
681     func = fir::runtime::getRuntimeFunc<mkRTKey(MinvalInteger8)>(loc, builder);
682   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
683     func = fir::runtime::getRuntimeFunc<ForcedMinvalInteger16>(loc, builder);
684   else
685     fir::emitFatalError(loc, "invalid type in MINVAL");
686 
687   auto fTy = func.getFunctionType();
688   auto sourceFile = fir::factory::locationToFilename(builder, loc);
689   auto sourceLine =
690       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
691   auto args = fir::runtime::createArguments(
692       builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
693 
694   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
695 }
696 
697 /// Generate call to `ProductDim` intrinsic runtime routine. This is the version
698 /// that handles any rank array with the dim argument specified.
genProductDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox)699 void fir::runtime::genProductDim(fir::FirOpBuilder &builder, mlir::Location loc,
700                                  mlir::Value resultBox, mlir::Value arrayBox,
701                                  mlir::Value dim, mlir::Value maskBox) {
702   auto func = fir::runtime::getRuntimeFunc<mkRTKey(ProductDim)>(loc, builder);
703   genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
704 }
705 
706 /// Generate call to `Product` intrinsic runtime routine. This is the version
707 /// that does not take a dim argument.
genProduct(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value arrayBox,mlir::Value maskBox,mlir::Value resultBox)708 mlir::Value fir::runtime::genProduct(fir::FirOpBuilder &builder,
709                                      mlir::Location loc, mlir::Value arrayBox,
710                                      mlir::Value maskBox,
711                                      mlir::Value resultBox) {
712   mlir::func::FuncOp func;
713   auto ty = arrayBox.getType();
714   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
715   auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
716   auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
717 
718   if (eleTy.isF16() || eleTy.isBF16())
719     TODO(loc, "half-precision PRODUCT");
720   else if (eleTy.isF32())
721     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductReal4)>(loc, builder);
722   else if (eleTy.isF64())
723     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductReal8)>(loc, builder);
724   else if (eleTy.isF80())
725     func = fir::runtime::getRuntimeFunc<ForcedProductReal10>(loc, builder);
726   else if (eleTy.isF128())
727     func = fir::runtime::getRuntimeFunc<ForcedProductReal16>(loc, builder);
728   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
729     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger1)>(loc, builder);
730   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
731     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger2)>(loc, builder);
732   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
733     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger4)>(loc, builder);
734   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
735     func = fir::runtime::getRuntimeFunc<mkRTKey(ProductInteger8)>(loc, builder);
736   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
737     func = fir::runtime::getRuntimeFunc<ForcedProductInteger16>(loc, builder);
738   else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
739     func =
740         fir::runtime::getRuntimeFunc<mkRTKey(CppProductComplex4)>(loc, builder);
741   else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
742     func =
743         fir::runtime::getRuntimeFunc<mkRTKey(CppProductComplex8)>(loc, builder);
744   else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
745     func = fir::runtime::getRuntimeFunc<ForcedProductComplex10>(loc, builder);
746   else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
747     func = fir::runtime::getRuntimeFunc<ForcedProductComplex16>(loc, builder);
748   else if (eleTy == fir::ComplexType::get(builder.getContext(), 2) ||
749            eleTy == fir::ComplexType::get(builder.getContext(), 3))
750     TODO(loc, "half-precision PRODUCT");
751   else
752     fir::emitFatalError(loc, "invalid type in PRODUCT");
753 
754   auto fTy = func.getFunctionType();
755   auto sourceFile = fir::factory::locationToFilename(builder, loc);
756   if (fir::isa_complex(eleTy)) {
757     auto sourceLine =
758         fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
759     auto args =
760         fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox,
761                                       sourceFile, sourceLine, dim, maskBox);
762     builder.create<fir::CallOp>(loc, func, args);
763     return resultBox;
764   }
765 
766   auto sourceLine =
767       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
768   auto args = fir::runtime::createArguments(
769       builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
770 
771   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
772 }
773 
774 /// Generate call to `DotProduct` intrinsic runtime routine.
genDotProduct(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value vectorABox,mlir::Value vectorBBox,mlir::Value resultBox)775 mlir::Value fir::runtime::genDotProduct(fir::FirOpBuilder &builder,
776                                         mlir::Location loc,
777                                         mlir::Value vectorABox,
778                                         mlir::Value vectorBBox,
779                                         mlir::Value resultBox) {
780   mlir::func::FuncOp func;
781   auto ty = vectorABox.getType();
782   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
783   auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
784 
785   if (eleTy.isF16() || eleTy.isBF16())
786     TODO(loc, "half-precision DOTPRODUCT");
787   else if (eleTy.isF32())
788     func = fir::runtime::getRuntimeFunc<mkRTKey(DotProductReal4)>(loc, builder);
789   else if (eleTy.isF64())
790     func = fir::runtime::getRuntimeFunc<mkRTKey(DotProductReal8)>(loc, builder);
791   else if (eleTy.isF80())
792     func = fir::runtime::getRuntimeFunc<ForcedDotProductReal10>(loc, builder);
793   else if (eleTy.isF128())
794     func = fir::runtime::getRuntimeFunc<ForcedDotProductReal16>(loc, builder);
795   else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
796     func = fir::runtime::getRuntimeFunc<mkRTKey(CppDotProductComplex4)>(
797         loc, builder);
798   else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
799     func = fir::runtime::getRuntimeFunc<mkRTKey(CppDotProductComplex8)>(
800         loc, builder);
801   else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
802     func =
803         fir::runtime::getRuntimeFunc<ForcedDotProductComplex10>(loc, builder);
804   else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
805     func =
806         fir::runtime::getRuntimeFunc<ForcedDotProductComplex16>(loc, builder);
807   else if (eleTy == fir::ComplexType::get(builder.getContext(), 2) ||
808            eleTy == fir::ComplexType::get(builder.getContext(), 3))
809     TODO(loc, "half-precision DOTPRODUCT");
810   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
811     func =
812         fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger1)>(loc, builder);
813   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
814     func =
815         fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger2)>(loc, builder);
816   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
817     func =
818         fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger4)>(loc, builder);
819   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
820     func =
821         fir::runtime::getRuntimeFunc<mkRTKey(DotProductInteger8)>(loc, builder);
822   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
823     func =
824         fir::runtime::getRuntimeFunc<ForcedDotProductInteger16>(loc, builder);
825   else if (eleTy.isa<fir::LogicalType>())
826     func =
827         fir::runtime::getRuntimeFunc<mkRTKey(DotProductLogical)>(loc, builder);
828   else
829     fir::emitFatalError(loc, "invalid type in DOTPRODUCT");
830 
831   auto fTy = func.getFunctionType();
832   auto sourceFile = fir::factory::locationToFilename(builder, loc);
833 
834   if (fir::isa_complex(eleTy)) {
835     auto sourceLine =
836         fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
837     auto args =
838         fir::runtime::createArguments(builder, loc, fTy, resultBox, vectorABox,
839                                       vectorBBox, sourceFile, sourceLine);
840     builder.create<fir::CallOp>(loc, func, args);
841     return resultBox;
842   }
843 
844   auto sourceLine =
845       fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
846   auto args = fir::runtime::createArguments(builder, loc, fTy, vectorABox,
847                                             vectorBBox, sourceFile, sourceLine);
848   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
849 }
850 /// Generate call to `SumDim` intrinsic runtime routine. This is the version
851 /// that handles any rank array with the dim argument specified.
genSumDim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value arrayBox,mlir::Value dim,mlir::Value maskBox)852 void fir::runtime::genSumDim(fir::FirOpBuilder &builder, mlir::Location loc,
853                              mlir::Value resultBox, mlir::Value arrayBox,
854                              mlir::Value dim, mlir::Value maskBox) {
855   auto func = fir::runtime::getRuntimeFunc<mkRTKey(SumDim)>(loc, builder);
856   genReduction3Args(func, builder, loc, resultBox, arrayBox, dim, maskBox);
857 }
858 
859 /// Generate call to `Sum` intrinsic runtime routine. This is the version
860 /// that does not take a dim argument.
genSum(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value arrayBox,mlir::Value maskBox,mlir::Value resultBox)861 mlir::Value fir::runtime::genSum(fir::FirOpBuilder &builder, mlir::Location loc,
862                                  mlir::Value arrayBox, mlir::Value maskBox,
863                                  mlir::Value resultBox) {
864   mlir::func::FuncOp func;
865   auto ty = arrayBox.getType();
866   auto arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
867   auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
868   auto dim = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
869 
870   if (eleTy.isF16() || eleTy.isBF16())
871     TODO(loc, "half-precision SUM");
872   else if (eleTy.isF32())
873     func = fir::runtime::getRuntimeFunc<mkRTKey(SumReal4)>(loc, builder);
874   else if (eleTy.isF64())
875     func = fir::runtime::getRuntimeFunc<mkRTKey(SumReal8)>(loc, builder);
876   else if (eleTy.isF80())
877     func = fir::runtime::getRuntimeFunc<ForcedSumReal10>(loc, builder);
878   else if (eleTy.isF128())
879     func = fir::runtime::getRuntimeFunc<ForcedSumReal16>(loc, builder);
880   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(1)))
881     func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger1)>(loc, builder);
882   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(2)))
883     func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger2)>(loc, builder);
884   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(4)))
885     func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger4)>(loc, builder);
886   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(8)))
887     func = fir::runtime::getRuntimeFunc<mkRTKey(SumInteger8)>(loc, builder);
888   else if (eleTy.isInteger(builder.getKindMap().getIntegerBitsize(16)))
889     func = fir::runtime::getRuntimeFunc<ForcedSumInteger16>(loc, builder);
890   else if (eleTy == fir::ComplexType::get(builder.getContext(), 4))
891     func = fir::runtime::getRuntimeFunc<mkRTKey(CppSumComplex4)>(loc, builder);
892   else if (eleTy == fir::ComplexType::get(builder.getContext(), 8))
893     func = fir::runtime::getRuntimeFunc<mkRTKey(CppSumComplex8)>(loc, builder);
894   else if (eleTy == fir::ComplexType::get(builder.getContext(), 10))
895     func = fir::runtime::getRuntimeFunc<ForcedSumComplex10>(loc, builder);
896   else if (eleTy == fir::ComplexType::get(builder.getContext(), 16))
897     func = fir::runtime::getRuntimeFunc<ForcedSumComplex16>(loc, builder);
898   else if (eleTy == fir::ComplexType::get(builder.getContext(), 2) ||
899            eleTy == fir::ComplexType::get(builder.getContext(), 3))
900     TODO(loc, "half-precision SUM");
901   else
902     fir::emitFatalError(loc, "invalid type in SUM");
903 
904   auto fTy = func.getFunctionType();
905   auto sourceFile = fir::factory::locationToFilename(builder, loc);
906   if (fir::isa_complex(eleTy)) {
907     auto sourceLine =
908         fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
909     auto args =
910         fir::runtime::createArguments(builder, loc, fTy, resultBox, arrayBox,
911                                       sourceFile, sourceLine, dim, maskBox);
912     builder.create<fir::CallOp>(loc, func, args);
913     return resultBox;
914   }
915 
916   auto sourceLine =
917       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
918   auto args = fir::runtime::createArguments(
919       builder, loc, fTy, arrayBox, sourceFile, sourceLine, dim, maskBox);
920 
921   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
922 }
923