1 //===-- IntrinsicCall.cpp -------------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 //
9 // Helper routines for constructing the FIR dialect of MLIR. As FIR is a
10 // dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding
11 // style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this
12 // module.
13 //
14 //===----------------------------------------------------------------------===//
15 
16 #include "flang/Lower/IntrinsicCall.h"
17 #include "flang/Common/static-multimap-view.h"
18 #include "flang/Lower/Mangler.h"
19 #include "flang/Lower/Runtime.h"
20 #include "flang/Lower/StatementContext.h"
21 #include "flang/Lower/SymbolMap.h"
22 #include "flang/Lower/Todo.h"
23 #include "flang/Optimizer/Builder/Character.h"
24 #include "flang/Optimizer/Builder/Complex.h"
25 #include "flang/Optimizer/Builder/FIRBuilder.h"
26 #include "flang/Optimizer/Builder/MutableBox.h"
27 #include "flang/Optimizer/Builder/Runtime/Character.h"
28 #include "flang/Optimizer/Builder/Runtime/Command.h"
29 #include "flang/Optimizer/Builder/Runtime/Inquiry.h"
30 #include "flang/Optimizer/Builder/Runtime/Numeric.h"
31 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
32 #include "flang/Optimizer/Builder/Runtime/Reduction.h"
33 #include "flang/Optimizer/Builder/Runtime/Stop.h"
34 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
35 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
36 #include "flang/Optimizer/Support/FatalError.h"
37 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
38 #include "llvm/Support/CommandLine.h"
39 #include "llvm/Support/Debug.h"
40 
41 #define DEBUG_TYPE "flang-lower-intrinsic"
42 
43 #define PGMATH_DECLARE
44 #include "flang/Evaluate/pgmath.h.inc"
45 
46 /// This file implements lowering of Fortran intrinsic procedures.
47 /// Intrinsics are lowered to a mix of FIR and MLIR operations as
48 /// well as call to runtime functions or LLVM intrinsics.
49 
50 /// Lowering of intrinsic procedure calls is based on a map that associates
51 /// Fortran intrinsic generic names to FIR generator functions.
52 /// All generator functions are member functions of the IntrinsicLibrary class
53 /// and have the same interface.
54 /// If no generator is given for an intrinsic name, a math runtime library
55 /// is searched for an implementation and, if a runtime function is found,
56 /// a call is generated for it. LLVM intrinsics are handled as a math
57 /// runtime library here.
58 
59 /// Enums used to templatize and share lowering of MIN and MAX.
60 enum class Extremum { Min, Max };
61 
62 // There are different ways to deal with NaNs in MIN and MAX.
63 // Known existing behaviors are listed below and can be selected for
64 // f18 MIN/MAX implementation.
65 enum class ExtremumBehavior {
66   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
67   // not described because there is no way to control/observe such aspect in
68   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
69   // aspect that are therefore currently not enforced. In the descriptions
70   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
71   // if one of the input NaN was signaling but it cannot be guaranteed either.
72   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
73   // signaling/quiet requirements.
74   IeeeMinMaximumNumber,
75   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
76   // If one of the argument is and number and the other is NaN, return the
77   // number. If both arguements are NaN, return NaN.
78   // Compilers: gfortran.
79   IeeeMinMaximum,
80   // IEEE minimum/maximum behavior (754-2019, section 9.6):
81   // If one of the argument is NaN, return NaN.
82   MinMaxss,
83   // x86 minss/maxss behavior:
84   // If the second argument is a number and the other is NaN, return the number.
85   // In all other cases where at least one operand is NaN, return NaN.
86   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
87   PgfortranLlvm,
88   // "Opposite of" x86 minss/maxss behavior:
89   // If the first argument is a number and the other is NaN, return the
90   // number.
91   // In all other cases where at least one operand is NaN, return NaN.
92   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
93   IeeeMinMaxNum
94   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
95   // TODO: Not implemented.
96   // It is the only behavior where the signaling/quiet aspect of a NaN argument
97   // impacts if the result should be NaN or the argument that is a number.
98   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
99   // possible to implement it without some target dependent runtime.
100 };
101 
102 fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() {
103   return fir::UnboxedValue{};
104 }
105 
106 /// Test if an ExtendedValue is absent.
107 static bool isAbsent(const fir::ExtendedValue &exv) {
108   return !fir::getBase(exv);
109 }
110 static bool isAbsent(llvm::ArrayRef<fir::ExtendedValue> args, size_t argIndex) {
111   return args.size() <= argIndex || isAbsent(args[argIndex]);
112 }
113 static bool isAbsent(llvm::ArrayRef<mlir::Value> args, size_t argIndex) {
114   return args.size() <= argIndex || !args[argIndex];
115 }
116 
117 /// Test if an ExtendedValue is present.
118 static bool isPresent(const fir::ExtendedValue &exv) { return !isAbsent(exv); }
119 
120 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
121 /// take a DIM argument.
122 template <typename FD>
123 static fir::ExtendedValue
124 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
125            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
126            llvm::StringRef errMsg, mlir::Value array, fir::ExtendedValue dimArg,
127            mlir::Value mask, int rank) {
128 
129   // Create mutable fir.box to be passed to the runtime for the result.
130   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
131   fir::MutableBoxValue resultMutableBox =
132       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
133   mlir::Value resultIrBox =
134       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
135 
136   mlir::Value dim =
137       isAbsent(dimArg)
138           ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
139           : fir::getBase(dimArg);
140   funcDim(builder, loc, resultIrBox, array, dim, mask);
141 
142   fir::ExtendedValue res =
143       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
144   return res.match(
145       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
146         // Add cleanup code
147         assert(stmtCtx);
148         fir::FirOpBuilder *bldr = &builder;
149         mlir::Value temp = box.getAddr();
150         stmtCtx->attachCleanup(
151             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
152         return box;
153       },
154       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
155         // Add cleanup code
156         assert(stmtCtx);
157         fir::FirOpBuilder *bldr = &builder;
158         mlir::Value temp = box.getAddr();
159         stmtCtx->attachCleanup(
160             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
161         return box;
162       },
163       [&](const auto &) -> fir::ExtendedValue {
164         fir::emitFatalError(loc, errMsg);
165       });
166 }
167 
168 /// Process calls to Product, Sum intrinsic functions
169 template <typename FN, typename FD>
170 static fir::ExtendedValue
171 genProdOrSum(FN func, FD funcDim, mlir::Type resultType,
172              fir::FirOpBuilder &builder, mlir::Location loc,
173              Fortran::lower::StatementContext *stmtCtx, llvm::StringRef errMsg,
174              llvm::ArrayRef<fir::ExtendedValue> args) {
175 
176   assert(args.size() == 3);
177 
178   // Handle required array argument
179   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
180   mlir::Value array = fir::getBase(arryTmp);
181   int rank = arryTmp.rank();
182   assert(rank >= 1);
183 
184   // Handle optional mask argument
185   auto mask = isAbsent(args[2])
186                   ? builder.create<fir::AbsentOp>(
187                         loc, fir::BoxType::get(builder.getI1Type()))
188                   : builder.createBox(loc, args[2]);
189 
190   bool absentDim = isAbsent(args[1]);
191 
192   // We call the type specific versions because the result is scalar
193   // in the case below.
194   if (absentDim || rank == 1) {
195     mlir::Type ty = array.getType();
196     mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
197     auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
198     if (fir::isa_complex(eleTy)) {
199       mlir::Value result = builder.createTemporary(loc, eleTy);
200       func(builder, loc, array, mask, result);
201       return builder.create<fir::LoadOp>(loc, result);
202     }
203     auto resultBox = builder.create<fir::AbsentOp>(
204         loc, fir::BoxType::get(builder.getI1Type()));
205     return func(builder, loc, array, mask, resultBox);
206   }
207   // Handle Product/Sum cases that have an array result.
208   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
209                     args[1], mask, rank);
210 }
211 
212 /// Process calls to DotProduct
213 template <typename FN>
214 static fir::ExtendedValue
215 genDotProd(FN func, mlir::Type resultType, fir::FirOpBuilder &builder,
216            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
217            llvm::ArrayRef<fir::ExtendedValue> args) {
218 
219   assert(args.size() == 2);
220 
221   // Handle required vector arguments
222   mlir::Value vectorA = fir::getBase(args[0]);
223   mlir::Value vectorB = fir::getBase(args[1]);
224 
225   mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy(vectorA.getType())
226                          .cast<fir::SequenceType>()
227                          .getEleTy();
228   if (fir::isa_complex(eleTy)) {
229     mlir::Value result = builder.createTemporary(loc, eleTy);
230     func(builder, loc, vectorA, vectorB, result);
231     return builder.create<fir::LoadOp>(loc, result);
232   }
233 
234   auto resultBox = builder.create<fir::AbsentOp>(
235       loc, fir::BoxType::get(builder.getI1Type()));
236   return func(builder, loc, vectorA, vectorB, resultBox);
237 }
238 
239 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions
240 template <typename FN, typename FD, typename FC>
241 static fir::ExtendedValue
242 genExtremumVal(FN func, FD funcDim, FC funcChar, mlir::Type resultType,
243                fir::FirOpBuilder &builder, mlir::Location loc,
244                Fortran::lower::StatementContext *stmtCtx,
245                llvm::StringRef errMsg,
246                llvm::ArrayRef<fir::ExtendedValue> args) {
247 
248   assert(args.size() == 3);
249 
250   // Handle required array argument
251   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
252   mlir::Value array = fir::getBase(arryTmp);
253   int rank = arryTmp.rank();
254   assert(rank >= 1);
255   bool hasCharacterResult = arryTmp.isCharacter();
256 
257   // Handle optional mask argument
258   auto mask = isAbsent(args[2])
259                   ? builder.create<fir::AbsentOp>(
260                         loc, fir::BoxType::get(builder.getI1Type()))
261                   : builder.createBox(loc, args[2]);
262 
263   bool absentDim = isAbsent(args[1]);
264 
265   // For Maxval/MinVal, we call the type specific versions of
266   // Maxval/Minval because the result is scalar in the case below.
267   if (!hasCharacterResult && (absentDim || rank == 1))
268     return func(builder, loc, array, mask);
269 
270   if (hasCharacterResult && (absentDim || rank == 1)) {
271     // Create mutable fir.box to be passed to the runtime for the result.
272     fir::MutableBoxValue resultMutableBox =
273         fir::factory::createTempMutableBox(builder, loc, resultType);
274     mlir::Value resultIrBox =
275         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
276 
277     funcChar(builder, loc, resultIrBox, array, mask);
278 
279     // Handle cleanup of allocatable result descriptor and return
280     fir::ExtendedValue res =
281         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
282     return res.match(
283         [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
284           // Add cleanup code
285           assert(stmtCtx);
286           fir::FirOpBuilder *bldr = &builder;
287           mlir::Value temp = box.getAddr();
288           stmtCtx->attachCleanup(
289               [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
290           return box;
291         },
292         [&](const auto &) -> fir::ExtendedValue {
293           fir::emitFatalError(loc, errMsg);
294         });
295   }
296 
297   // Handle Min/Maxval cases that have an array result.
298   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
299                     args[1], mask, rank);
300 }
301 
302 /// Process calls to Minloc, Maxloc intrinsic functions
303 template <typename FN, typename FD>
304 static fir::ExtendedValue genExtremumloc(
305     FN func, FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
306     mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
307     llvm::StringRef errMsg, llvm::ArrayRef<fir::ExtendedValue> args) {
308 
309   assert(args.size() == 5);
310 
311   // Handle required array argument
312   mlir::Value array = builder.createBox(loc, args[0]);
313   unsigned rank = fir::BoxValue(array).rank();
314   assert(rank >= 1);
315 
316   // Handle optional mask argument
317   auto mask = isAbsent(args[2])
318                   ? builder.create<fir::AbsentOp>(
319                         loc, fir::BoxType::get(builder.getI1Type()))
320                   : builder.createBox(loc, args[2]);
321 
322   // Handle optional kind argument
323   auto kind = isAbsent(args[3]) ? builder.createIntegerConstant(
324                                       loc, builder.getIndexType(),
325                                       builder.getKindMap().defaultIntegerKind())
326                                 : fir::getBase(args[3]);
327 
328   // Handle optional back argument
329   auto back = isAbsent(args[4]) ? builder.createBool(loc, false)
330                                 : fir::getBase(args[4]);
331 
332   bool absentDim = isAbsent(args[1]);
333 
334   if (!absentDim && rank == 1) {
335     // If dim argument is present and the array is rank 1, then the result is
336     // a scalar (since the the result is rank-1 or 0).
337     // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
338     mlir::Value dim = fir::getBase(args[1]);
339     // Create mutable fir.box to be passed to the runtime for the result.
340     fir::MutableBoxValue resultMutableBox =
341         fir::factory::createTempMutableBox(builder, loc, resultType);
342     mlir::Value resultIrBox =
343         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
344 
345     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
346 
347     // Handle cleanup of allocatable result descriptor and return
348     fir::ExtendedValue res =
349         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
350     return res.match(
351         [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
352           // Add cleanup code
353           assert(stmtCtx);
354           fir::FirOpBuilder *bldr = &builder;
355           stmtCtx->attachCleanup(
356               [=]() { bldr->create<fir::FreeMemOp>(loc, tempAddr); });
357           return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
358         },
359         [&](const auto &) -> fir::ExtendedValue {
360           fir::emitFatalError(loc, errMsg);
361         });
362   }
363 
364   // Note: The Min/Maxloc/val cases below have an array result.
365 
366   // Create mutable fir.box to be passed to the runtime for the result.
367   mlir::Type resultArrayType =
368       builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
369   fir::MutableBoxValue resultMutableBox =
370       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
371   mlir::Value resultIrBox =
372       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
373 
374   if (absentDim) {
375     // Handle min/maxloc/val case where there is no dim argument
376     // (calls Min/Maxloc()/MinMaxval() runtime routine)
377     func(builder, loc, resultIrBox, array, mask, kind, back);
378   } else {
379     // else handle min/maxloc case with dim argument (calls
380     // Min/Max/loc/val/Dim() runtime routine).
381     mlir::Value dim = fir::getBase(args[1]);
382     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
383   }
384 
385   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
386       .match(
387           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
388             // Add cleanup code
389             assert(stmtCtx);
390             fir::FirOpBuilder *bldr = &builder;
391             mlir::Value temp = box.getAddr();
392             stmtCtx->attachCleanup(
393                 [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
394             return box;
395           },
396           [&](const auto &) -> fir::ExtendedValue {
397             fir::emitFatalError(loc, errMsg);
398           });
399 }
400 
401 // TODO error handling -> return a code or directly emit messages ?
402 struct IntrinsicLibrary {
403 
404   // Constructors.
405   explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc,
406                             Fortran::lower::StatementContext *stmtCtx = nullptr)
407       : builder{builder}, loc{loc}, stmtCtx{stmtCtx} {}
408   IntrinsicLibrary() = delete;
409   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
410 
411   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
412   /// and expected result type \p resultType.
413   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
414                                       llvm::Optional<mlir::Type> resultType,
415                                       llvm::ArrayRef<fir::ExtendedValue> arg);
416 
417   /// Search a runtime function that is associated to the generic intrinsic name
418   /// and whose signature matches the intrinsic arguments and result types.
419   /// If no such runtime function is found but a runtime function associated
420   /// with the Fortran generic exists and has the same number of arguments,
421   /// conversions will be inserted before and/or after the call. This is to
422   /// mainly to allow 16 bits float support even-though little or no math
423   /// runtime is currently available for it.
424   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
425                              llvm::ArrayRef<mlir::Value>);
426 
427   using RuntimeCallGenerator = std::function<mlir::Value(
428       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
429   RuntimeCallGenerator
430   getRuntimeCallGenerator(llvm::StringRef name,
431                           mlir::FunctionType soughtFuncType);
432 
433   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
434   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
435   /// if the argument is an integer, into llvm intrinsics if the argument is
436   /// real and to the `hypot` math routine if the argument is of complex type.
437   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
438   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
439                                 mlir::Value, mlir::Value)>
440   fir::ExtendedValue genAdjustRtCall(mlir::Type,
441                                      llvm::ArrayRef<fir::ExtendedValue>);
442   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
443   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
444   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
445   fir::ExtendedValue genAllocated(mlir::Type,
446                                   llvm::ArrayRef<fir::ExtendedValue>);
447   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
448   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
449   fir::ExtendedValue genAssociated(mlir::Type,
450                                    llvm::ArrayRef<fir::ExtendedValue>);
451   mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
452   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
453   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
454   fir::ExtendedValue
455       genCommandArgumentCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
456   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
457   template <mlir::arith::CmpIPredicate pred>
458   fir::ExtendedValue genCharacterCompare(mlir::Type,
459                                          llvm::ArrayRef<fir::ExtendedValue>);
460   mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
461   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
462   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
463   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
464   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
465   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
466   fir::ExtendedValue genDotProduct(mlir::Type,
467                                    llvm::ArrayRef<fir::ExtendedValue>);
468   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
469   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
470   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
471   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
472   template <Extremum, ExtremumBehavior>
473   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
474   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
475   mlir::Value genFraction(mlir::Type resultType,
476                           mlir::ArrayRef<mlir::Value> args);
477   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
478   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
479   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
480   /// in the llvm::ArrayRef.
481   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
482   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
483   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
484   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
485   fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
486   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
487   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
488   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
489   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
490   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
491   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
492   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
493   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
494   fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
495   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
496   fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
497   fir::ExtendedValue genMerge(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
498   fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
499   fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
500   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
501   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
502   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
503   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
504   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
505   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
506   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
507   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
508   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
509   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
510   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
511   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
512   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
513   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
514   mlir::Value genRRSpacing(mlir::Type resultType,
515                            llvm::ArrayRef<mlir::Value> args);
516   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
517   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
518   mlir::Value genSetExponent(mlir::Type resultType,
519                              llvm::ArrayRef<mlir::Value> args);
520   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
521   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
522   mlir::Value genSpacing(mlir::Type resultType,
523                          llvm::ArrayRef<mlir::Value> args);
524   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
525   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
526   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
527   fir::ExtendedValue genTransfer(mlir::Type,
528                                  llvm::ArrayRef<fir::ExtendedValue>);
529   fir::ExtendedValue genTranspose(mlir::Type,
530                                   llvm::ArrayRef<fir::ExtendedValue>);
531   fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
532   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
533   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
534   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
535   /// Implement all conversion functions like DBLE, the first argument is
536   /// the value to convert. There may be an additional KIND arguments that
537   /// is ignored because this is already reflected in the result type.
538   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
539 
540   /// Define the different FIR generators that can be mapped to intrinsic to
541   /// generate the related code.
542   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
543   using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum);
544   using SubroutineGenerator = decltype(&IntrinsicLibrary::genRandomInit);
545   using Generator =
546       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
547 
548   template <typename GeneratorType>
549   fir::ExtendedValue
550   outlineInExtendedWrapper(GeneratorType, llvm::StringRef name,
551                            llvm::Optional<mlir::Type> resultType,
552                            llvm::ArrayRef<fir::ExtendedValue> args);
553 
554   template <typename GeneratorType>
555   mlir::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
556                           mlir::FunctionType, bool loadRefArguments = false);
557 
558   /// Generate calls to ElementalGenerator, handling the elemental aspects
559   template <typename GeneratorType>
560   fir::ExtendedValue
561   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
562                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
563 
564   /// Helper to invoke code generator for the intrinsics given arguments.
565   mlir::Value invokeGenerator(ElementalGenerator generator,
566                               mlir::Type resultType,
567                               llvm::ArrayRef<mlir::Value> args);
568   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
569                               mlir::Type resultType,
570                               llvm::ArrayRef<mlir::Value> args);
571   mlir::Value invokeGenerator(ExtendedGenerator generator,
572                               mlir::Type resultType,
573                               llvm::ArrayRef<mlir::Value> args);
574   mlir::Value invokeGenerator(SubroutineGenerator generator,
575                               llvm::ArrayRef<mlir::Value> args);
576 
577   /// Add clean-up for \p temp to the current statement context;
578   void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
579   /// Helper function for generating code clean-up for result descriptors
580   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
581                                        mlir::Type resultType,
582                                        llvm::StringRef errMsg);
583 
584   fir::FirOpBuilder &builder;
585   mlir::Location loc;
586   Fortran::lower::StatementContext *stmtCtx;
587 };
588 
589 struct IntrinsicDummyArgument {
590   const char *name = nullptr;
591   Fortran::lower::LowerIntrinsicArgAs lowerAs =
592       Fortran::lower::LowerIntrinsicArgAs::Value;
593   bool handleDynamicOptional = false;
594 };
595 
596 struct Fortran::lower::IntrinsicArgumentLoweringRules {
597   /// There is no more than 7 non repeated arguments in Fortran intrinsics.
598   IntrinsicDummyArgument args[7];
599   constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
600 };
601 
602 /// Structure describing what needs to be done to lower intrinsic "name".
603 struct IntrinsicHandler {
604   const char *name;
605   IntrinsicLibrary::Generator generator;
606   // The following may be omitted in the table below.
607   Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
608   bool isElemental = true;
609   /// Code heavy intrinsic can be outlined to make FIR
610   /// more readable.
611   bool outline = false;
612 };
613 
614 constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
615 constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
616 constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
617 constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
618 using I = IntrinsicLibrary;
619 
620 /// Flag to indicate that an intrinsic argument has to be handled as
621 /// being dynamically optional (e.g. special handling when actual
622 /// argument is an optional variable in the current scope).
623 static constexpr bool handleDynamicOptional = true;
624 
625 /// Table that drives the fir generation depending on the intrinsic.
626 /// one to one mapping with Fortran arguments. If no mapping is
627 /// defined here for a generic intrinsic, genRuntimeCall will be called
628 /// to look for a match in the runtime a emit a call. Note that the argument
629 /// lowering rules for an intrinsic need to be provided only if at least one
630 /// argument must not be lowered by value. In which case, the lowering rules
631 /// should be provided for all the intrinsic arguments for completeness.
632 static constexpr IntrinsicHandler handlers[]{
633     {"abs", &I::genAbs},
634     {"adjustl",
635      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
636      {{{"string", asAddr}}},
637      /*isElemental=*/true},
638     {"adjustr",
639      &I::genAdjustRtCall<fir::runtime::genAdjustR>,
640      {{{"string", asAddr}}},
641      /*isElemental=*/true},
642     {"aimag", &I::genAimag},
643     {"aint", &I::genAint},
644     {"all",
645      &I::genAll,
646      {{{"mask", asAddr}, {"dim", asValue}}},
647      /*isElemental=*/false},
648     {"allocated",
649      &I::genAllocated,
650      {{{"array", asInquired}, {"scalar", asInquired}}},
651      /*isElemental=*/false},
652     {"anint", &I::genAnint},
653     {"any",
654      &I::genAny,
655      {{{"mask", asAddr}, {"dim", asValue}}},
656      /*isElemental=*/false},
657     {"associated",
658      &I::genAssociated,
659      {{{"pointer", asInquired}, {"target", asInquired}}},
660      /*isElemental=*/false},
661     {"btest", &I::genBtest},
662     {"ceiling", &I::genCeiling},
663     {"char", &I::genChar},
664     {"cmplx",
665      &I::genCmplx,
666      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
667     {"command_argument_count", &I::genCommandArgumentCount},
668     {"conjg", &I::genConjg},
669     {"count",
670      &I::genCount,
671      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
672      /*isElemental=*/false},
673     {"cpu_time",
674      &I::genCpuTime,
675      {{{"time", asAddr}}},
676      /*isElemental=*/false},
677     {"cshift",
678      &I::genCshift,
679      {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
680      /*isElemental=*/false},
681     {"date_and_time",
682      &I::genDateAndTime,
683      {{{"date", asAddr, handleDynamicOptional},
684        {"time", asAddr, handleDynamicOptional},
685        {"zone", asAddr, handleDynamicOptional},
686        {"values", asBox, handleDynamicOptional}}},
687      /*isElemental=*/false},
688     {"dble", &I::genConversion},
689     {"dim", &I::genDim},
690     {"dot_product",
691      &I::genDotProduct,
692      {{{"vector_a", asBox}, {"vector_b", asBox}}},
693      /*isElemental=*/false},
694     {"dprod", &I::genDprod},
695     {"eoshift",
696      &I::genEoshift,
697      {{{"array", asBox},
698        {"shift", asAddr},
699        {"boundary", asBox, handleDynamicOptional},
700        {"dim", asValue}}},
701      /*isElemental=*/false},
702     {"exit",
703      &I::genExit,
704      {{{"status", asValue}}},
705      /*isElemental=*/false},
706     {"exponent", &I::genExponent},
707     {"floor", &I::genFloor},
708     {"fraction", &I::genFraction},
709     {"get_command_argument",
710      &I::genGetCommandArgument,
711      {{{"number", asValue},
712        {"value", asAddr},
713        {"length", asAddr},
714        {"status", asAddr},
715        {"errmsg", asAddr}}},
716      /*isElemental=*/false},
717     {"get_environment_variable",
718      &I::genGetEnvironmentVariable,
719      {{{"name", asValue},
720        {"value", asAddr},
721        {"length", asAddr},
722        {"status", asAddr},
723        {"trim_name", asValue},
724        {"errmsg", asAddr}}},
725      /*isElemental=*/false},
726     {"iachar", &I::genIchar},
727     {"iand", &I::genIand},
728     {"ibclr", &I::genIbclr},
729     {"ibits", &I::genIbits},
730     {"ibset", &I::genIbset},
731     {"ichar", &I::genIchar},
732     {"ieor", &I::genIeor},
733     {"index",
734      &I::genIndex,
735      {{{"string", asAddr},
736        {"substring", asAddr},
737        {"back", asValue, handleDynamicOptional},
738        {"kind", asValue}}}},
739     {"ior", &I::genIor},
740     {"ishft", &I::genIshft},
741     {"ishftc", &I::genIshftc},
742     {"lbound",
743      &I::genLbound,
744      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
745      /*isElemental=*/false},
746     {"len",
747      &I::genLen,
748      {{{"string", asInquired}, {"kind", asValue}}},
749      /*isElemental=*/false},
750     {"len_trim", &I::genLenTrim},
751     {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
752     {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
753     {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
754     {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
755     {"matmul",
756      &I::genMatmul,
757      {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
758      /*isElemental=*/false},
759     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
760     {"maxloc",
761      &I::genMaxloc,
762      {{{"array", asBox},
763        {"dim", asValue},
764        {"mask", asBox, handleDynamicOptional},
765        {"kind", asValue},
766        {"back", asValue, handleDynamicOptional}}},
767      /*isElemental=*/false},
768     {"maxval",
769      &I::genMaxval,
770      {{{"array", asBox},
771        {"dim", asValue},
772        {"mask", asBox, handleDynamicOptional}}},
773      /*isElemental=*/false},
774     {"merge", &I::genMerge},
775     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
776     {"minloc",
777      &I::genMinloc,
778      {{{"array", asBox},
779        {"dim", asValue},
780        {"mask", asBox, handleDynamicOptional},
781        {"kind", asValue},
782        {"back", asValue, handleDynamicOptional}}},
783      /*isElemental=*/false},
784     {"minval",
785      &I::genMinval,
786      {{{"array", asBox},
787        {"dim", asValue},
788        {"mask", asBox, handleDynamicOptional}}},
789      /*isElemental=*/false},
790     {"mod", &I::genMod},
791     {"modulo", &I::genModulo},
792     {"nearest", &I::genNearest},
793     {"nint", &I::genNint},
794     {"not", &I::genNot},
795     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
796     {"pack",
797      &I::genPack,
798      {{{"array", asBox},
799        {"mask", asBox},
800        {"vector", asBox, handleDynamicOptional}}},
801      /*isElemental=*/false},
802     {"present",
803      &I::genPresent,
804      {{{"a", asInquired}}},
805      /*isElemental=*/false},
806     {"product",
807      &I::genProduct,
808      {{{"array", asBox},
809        {"dim", asValue},
810        {"mask", asBox, handleDynamicOptional}}},
811      /*isElemental=*/false},
812     {"random_init",
813      &I::genRandomInit,
814      {{{"repeatable", asValue}, {"image_distinct", asValue}}},
815      /*isElemental=*/false},
816     {"random_number",
817      &I::genRandomNumber,
818      {{{"harvest", asBox}}},
819      /*isElemental=*/false},
820     {"random_seed",
821      &I::genRandomSeed,
822      {{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
823      /*isElemental=*/false},
824     {"repeat",
825      &I::genRepeat,
826      {{{"string", asAddr}, {"ncopies", asValue}}},
827      /*isElemental=*/false},
828     {"reshape",
829      &I::genReshape,
830      {{{"source", asBox},
831        {"shape", asBox},
832        {"pad", asBox, handleDynamicOptional},
833        {"order", asBox, handleDynamicOptional}}},
834      /*isElemental=*/false},
835     {"rrspacing", &I::genRRSpacing},
836     {"scale",
837      &I::genScale,
838      {{{"x", asValue}, {"i", asValue}}},
839      /*isElemental=*/true},
840     {"scan",
841      &I::genScan,
842      {{{"string", asAddr},
843        {"set", asAddr},
844        {"back", asValue, handleDynamicOptional},
845        {"kind", asValue}}},
846      /*isElemental=*/true},
847     {"set_exponent", &I::genSetExponent},
848     {"sign", &I::genSign},
849     {"size",
850      &I::genSize,
851      {{{"array", asBox},
852        {"dim", asAddr, handleDynamicOptional},
853        {"kind", asValue}}},
854      /*isElemental=*/false},
855     {"spacing", &I::genSpacing},
856     {"spread",
857      &I::genSpread,
858      {{{"source", asAddr}, {"dim", asValue}, {"ncopies", asValue}}},
859      /*isElemental=*/false},
860     {"sum",
861      &I::genSum,
862      {{{"array", asBox},
863        {"dim", asValue},
864        {"mask", asBox, handleDynamicOptional}}},
865      /*isElemental=*/false},
866     {"system_clock",
867      &I::genSystemClock,
868      {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
869      /*isElemental=*/false},
870     {"transfer",
871      &I::genTransfer,
872      {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
873      /*isElemental=*/false},
874     {"transpose",
875      &I::genTranspose,
876      {{{"matrix", asAddr}}},
877      /*isElemental=*/false},
878     {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
879     {"ubound",
880      &I::genUbound,
881      {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
882      /*isElemental=*/false},
883     {"unpack",
884      &I::genUnpack,
885      {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
886      /*isElemental=*/false},
887     {"verify",
888      &I::genVerify,
889      {{{"string", asAddr},
890        {"set", asAddr},
891        {"back", asValue, handleDynamicOptional},
892        {"kind", asValue}}},
893      /*isElemental=*/true},
894 };
895 
896 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
897   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
898     return name.compare(handler.name) > 0;
899   };
900   auto result =
901       std::lower_bound(std::begin(handlers), std::end(handlers), name, compare);
902   return result != std::end(handlers) && result->name == name ? result
903                                                               : nullptr;
904 }
905 
906 /// To make fir output more readable for debug, one can outline all intrinsic
907 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
908 static llvm::cl::opt<bool> outlineAllIntrinsics(
909     "outline-intrinsics",
910     llvm::cl::desc(
911         "Lower all intrinsic procedure implementation in their own functions"),
912     llvm::cl::init(false));
913 
914 //===----------------------------------------------------------------------===//
915 // Math runtime description and matching utility
916 //===----------------------------------------------------------------------===//
917 
918 /// Command line option to modify math runtime version used to implement
919 /// intrinsics.
920 enum MathRuntimeVersion { fastVersion, llvmOnly };
921 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
922     "math-runtime", llvm::cl::desc("Select math runtime version:"),
923     llvm::cl::values(
924         clEnumValN(fastVersion, "fast", "use pgmath fast runtime"),
925         clEnumValN(llvmOnly, "llvm",
926                    "only use LLVM intrinsics (may be incomplete)")),
927     llvm::cl::init(fastVersion));
928 
929 struct RuntimeFunction {
930   // llvm::StringRef comparison operator are not constexpr, so use string_view.
931   using Key = std::string_view;
932   // Needed for implicit compare with keys.
933   constexpr operator Key() const { return key; }
934   Key key; // intrinsic name
935   llvm::StringRef symbol;
936   fir::runtime::FuncTypeBuilderFunc typeGenerator;
937 };
938 
939 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
940   {#name, #func, fir::runtime::RuntimeTableKey<decltype(func)>::getTypeModel()},
941 static constexpr RuntimeFunction pgmathFast[] = {
942 #define PGMATH_FAST
943 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
944 #include "flang/Evaluate/pgmath.h.inc"
945 };
946 
947 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
948   mlir::Type t = mlir::FloatType::getF32(context);
949   return mlir::FunctionType::get(context, {t}, {t});
950 }
951 
952 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
953   mlir::Type t = mlir::FloatType::getF64(context);
954   return mlir::FunctionType::get(context, {t}, {t});
955 }
956 
957 static mlir::FunctionType genF32F32F32FuncType(mlir::MLIRContext *context) {
958   auto t = mlir::FloatType::getF32(context);
959   return mlir::FunctionType::get(context, {t, t}, {t});
960 }
961 
962 static mlir::FunctionType genF64F64F64FuncType(mlir::MLIRContext *context) {
963   auto t = mlir::FloatType::getF64(context);
964   return mlir::FunctionType::get(context, {t, t}, {t});
965 }
966 
967 static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) {
968   auto t = mlir::FloatType::getF80(context);
969   return mlir::FunctionType::get(context, {t, t}, {t});
970 }
971 
972 static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) {
973   auto t = mlir::FloatType::getF128(context);
974   return mlir::FunctionType::get(context, {t, t}, {t});
975 }
976 
977 template <int Bits>
978 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
979   auto t = mlir::FloatType::getF64(context);
980   auto r = mlir::IntegerType::get(context, Bits);
981   return mlir::FunctionType::get(context, {t}, {r});
982 }
983 
984 template <int Bits>
985 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
986   auto t = mlir::FloatType::getF32(context);
987   auto r = mlir::IntegerType::get(context, Bits);
988   return mlir::FunctionType::get(context, {t}, {r});
989 }
990 
991 // TODO : Fill-up this table with more intrinsic.
992 // Note: These are also defined as operations in LLVM dialect. See if this
993 // can be use and has advantages.
994 static constexpr RuntimeFunction llvmIntrinsics[] = {
995     {"abs", "llvm.fabs.f32", genF32F32FuncType},
996     {"abs", "llvm.fabs.f64", genF64F64FuncType},
997     {"aint", "llvm.trunc.f32", genF32F32FuncType},
998     {"aint", "llvm.trunc.f64", genF64F64FuncType},
999     {"anint", "llvm.round.f32", genF32F32FuncType},
1000     {"anint", "llvm.round.f64", genF64F64FuncType},
1001     // ceil is used for CEILING but is different, it returns a real.
1002     {"ceil", "llvm.ceil.f32", genF32F32FuncType},
1003     {"ceil", "llvm.ceil.f64", genF64F64FuncType},
1004     // llvm.floor is used for FLOOR, but returns real.
1005     {"floor", "llvm.floor.f32", genF32F32FuncType},
1006     {"floor", "llvm.floor.f64", genF64F64FuncType},
1007     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>},
1008     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>},
1009     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>},
1010     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>},
1011     {"pow", "llvm.pow.f32", genF32F32F32FuncType},
1012     {"pow", "llvm.pow.f64", genF64F64F64FuncType},
1013     {"sign", "llvm.copysign.f32", genF32F32F32FuncType},
1014     {"sign", "llvm.copysign.f64", genF64F64F64FuncType},
1015     {"sign", "llvm.copysign.f80", genF80F80F80FuncType},
1016     {"sign", "llvm.copysign.f128", genF128F128F128FuncType},
1017 };
1018 
1019 // This helper class computes a "distance" between two function types.
1020 // The distance measures how many narrowing conversions of actual arguments
1021 // and result of "from" must be made in order to use "to" instead of "from".
1022 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1023 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1024 // if no implementation of ACOS(REAL(10)) is available, it is better to use
1025 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1026 // Note that this is not a symmetric distance and the order of "from" and "to"
1027 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1028 // may be safe to replace foo by bar, but not the opposite.
1029 class FunctionDistance {
1030 public:
1031   FunctionDistance() : infinite{true} {}
1032 
1033   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1034     unsigned nInputs = from.getNumInputs();
1035     unsigned nResults = from.getNumResults();
1036     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1037       infinite = true;
1038     } else {
1039       for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1040         addArgumentDistance(from.getInput(i), to.getInput(i));
1041       for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1042         addResultDistance(to.getResult(i), from.getResult(i));
1043     }
1044   }
1045 
1046   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1047   /// false if both d1 and d2 are infinite. This implies that
1048   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1049   bool isSmallerThan(const FunctionDistance &d) const {
1050     return !infinite &&
1051            (d.infinite || std::lexicographical_compare(
1052                               conversions.begin(), conversions.end(),
1053                               d.conversions.begin(), d.conversions.end()));
1054   }
1055 
1056   bool isLosingPrecision() const {
1057     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1058   }
1059 
1060   bool isInfinite() const { return infinite; }
1061 
1062 private:
1063   enum class Conversion { Forbidden, None, Narrow, Extend };
1064 
1065   void addArgumentDistance(mlir::Type from, mlir::Type to) {
1066     switch (conversionBetweenTypes(from, to)) {
1067     case Conversion::Forbidden:
1068       infinite = true;
1069       break;
1070     case Conversion::None:
1071       break;
1072     case Conversion::Narrow:
1073       conversions[narrowingArg]++;
1074       break;
1075     case Conversion::Extend:
1076       conversions[nonNarrowingArg]++;
1077       break;
1078     }
1079   }
1080 
1081   void addResultDistance(mlir::Type from, mlir::Type to) {
1082     switch (conversionBetweenTypes(from, to)) {
1083     case Conversion::Forbidden:
1084       infinite = true;
1085       break;
1086     case Conversion::None:
1087       break;
1088     case Conversion::Narrow:
1089       conversions[nonExtendingResult]++;
1090       break;
1091     case Conversion::Extend:
1092       conversions[extendingResult]++;
1093       break;
1094     }
1095   }
1096 
1097   // Floating point can be mlir::FloatType or fir::real
1098   static unsigned getFloatingPointWidth(mlir::Type t) {
1099     if (auto f{t.dyn_cast<mlir::FloatType>()})
1100       return f.getWidth();
1101     // FIXME: Get width another way for fir.real/complex
1102     // - use fir/KindMapping.h and llvm::Type
1103     // - or use evaluate/type.h
1104     if (auto r{t.dyn_cast<fir::RealType>()})
1105       return r.getFKind() * 4;
1106     if (auto cplx{t.dyn_cast<fir::ComplexType>()})
1107       return cplx.getFKind() * 4;
1108     llvm_unreachable("not a floating-point type");
1109   }
1110 
1111   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1112     if (from == to)
1113       return Conversion::None;
1114 
1115     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
1116       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
1117         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1118                                                          : Conversion::Extend;
1119       }
1120     }
1121 
1122     if (fir::isa_real(from) && fir::isa_real(to)) {
1123       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
1124                  ? Conversion::Narrow
1125                  : Conversion::Extend;
1126     }
1127 
1128     if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
1129       if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
1130         return getFloatingPointWidth(fromCplxTy) >
1131                        getFloatingPointWidth(toCplxTy)
1132                    ? Conversion::Narrow
1133                    : Conversion::Extend;
1134       }
1135     }
1136     // Notes:
1137     // - No conversion between character types, specialization of runtime
1138     // functions should be made instead.
1139     // - It is not clear there is a use case for automatic conversions
1140     // around Logical and it may damage hidden information in the physical
1141     // storage so do not do it.
1142     return Conversion::Forbidden;
1143   }
1144 
1145   // Below are indexes to access data in conversions.
1146   // The order in data does matter for lexicographical_compare
1147   enum {
1148     narrowingArg = 0,   // usually bad
1149     extendingResult,    // usually bad
1150     nonExtendingResult, // usually ok
1151     nonNarrowingArg,    // usually ok
1152     dataSize
1153   };
1154 
1155   std::array<int, dataSize> conversions = {};
1156   bool infinite = false; // When forbidden conversion or wrong argument number
1157 };
1158 
1159 /// Build mlir::FuncOp from runtime symbol description and add
1160 /// fir.runtime attribute.
1161 static mlir::FuncOp getFuncOp(mlir::Location loc, fir::FirOpBuilder &builder,
1162                               const RuntimeFunction &runtime) {
1163   mlir::FuncOp function = builder.addNamedFunction(
1164       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
1165   function->setAttr("fir.runtime", builder.getUnitAttr());
1166   return function;
1167 }
1168 
1169 /// Select runtime function that has the smallest distance to the intrinsic
1170 /// function type and that will not imply narrowing arguments or extending the
1171 /// result.
1172 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
1173 mlir::FuncOp searchFunctionInLibrary(
1174     mlir::Location loc, fir::FirOpBuilder &builder,
1175     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
1176     llvm::StringRef name, mlir::FunctionType funcType,
1177     const RuntimeFunction **bestNearMatch,
1178     FunctionDistance &bestMatchDistance) {
1179   std::pair<const RuntimeFunction *, const RuntimeFunction *> range =
1180       lib.equal_range(name);
1181   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1182     const RuntimeFunction &impl = *iter;
1183     mlir::FunctionType implType = impl.typeGenerator(builder.getContext());
1184     if (funcType == implType)
1185       return getFuncOp(loc, builder, impl); // exact match
1186 
1187     FunctionDistance distance(funcType, implType);
1188     if (distance.isSmallerThan(bestMatchDistance)) {
1189       *bestNearMatch = &impl;
1190       bestMatchDistance = std::move(distance);
1191     }
1192   }
1193   return {};
1194 }
1195 
1196 /// Search runtime for the best runtime function given an intrinsic name
1197 /// and interface. The interface may not be a perfect match in which case
1198 /// the caller is responsible to insert argument and return value conversions.
1199 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
1200 static mlir::FuncOp getRuntimeFunction(mlir::Location loc,
1201                                        fir::FirOpBuilder &builder,
1202                                        llvm::StringRef name,
1203                                        mlir::FunctionType funcType) {
1204   const RuntimeFunction *bestNearMatch = nullptr;
1205   FunctionDistance bestMatchDistance{};
1206   mlir::FuncOp match;
1207   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
1208   static constexpr RtMap pgmathF(pgmathFast);
1209   static_assert(pgmathF.Verify() && "map must be sorted");
1210   if (mathRuntimeVersion == fastVersion) {
1211     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
1212                                     &bestNearMatch, bestMatchDistance);
1213   } else {
1214     assert(mathRuntimeVersion == llvmOnly && "unknown math runtime");
1215   }
1216   if (match)
1217     return match;
1218 
1219   // Go through llvm intrinsics if not exact match in libpgmath or if
1220   // mathRuntimeVersion == llvmOnly
1221   static constexpr RtMap llvmIntr(llvmIntrinsics);
1222   static_assert(llvmIntr.Verify() && "map must be sorted");
1223   if (mlir::FuncOp exactMatch =
1224           searchFunctionInLibrary(loc, builder, llvmIntr, name, funcType,
1225                                   &bestNearMatch, bestMatchDistance))
1226     return exactMatch;
1227 
1228   if (bestNearMatch != nullptr) {
1229     if (bestMatchDistance.isLosingPrecision()) {
1230       // Using this runtime version requires narrowing the arguments
1231       // or extending the result. It is not numerically safe. There
1232       // is currently no quad math library that was described in
1233       // lowering and could be used here. Emit an error and continue
1234       // generating the code with the narrowing cast so that the user
1235       // can get a complete list of the problematic intrinsic calls.
1236       std::string message("TODO: no math runtime available for '");
1237       llvm::raw_string_ostream sstream(message);
1238       if (name == "pow") {
1239         assert(funcType.getNumInputs() == 2 &&
1240                "power operator has two arguments");
1241         sstream << funcType.getInput(0) << " ** " << funcType.getInput(1);
1242       } else {
1243         sstream << name << "(";
1244         if (funcType.getNumInputs() > 0)
1245           sstream << funcType.getInput(0);
1246         for (mlir::Type argType : funcType.getInputs().drop_front())
1247           sstream << ", " << argType;
1248         sstream << ")";
1249       }
1250       sstream << "'";
1251       mlir::emitError(loc, message);
1252     }
1253     return getFuncOp(loc, builder, *bestNearMatch);
1254   }
1255   return {};
1256 }
1257 
1258 /// Helpers to get function type from arguments and result type.
1259 static mlir::FunctionType getFunctionType(llvm::Optional<mlir::Type> resultType,
1260                                           llvm::ArrayRef<mlir::Value> arguments,
1261                                           fir::FirOpBuilder &builder) {
1262   llvm::SmallVector<mlir::Type> argTypes;
1263   for (mlir::Value arg : arguments)
1264     argTypes.push_back(arg.getType());
1265   llvm::SmallVector<mlir::Type> resTypes;
1266   if (resultType)
1267     resTypes.push_back(*resultType);
1268   return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,
1269                                  resTypes);
1270 }
1271 
1272 /// fir::ExtendedValue to mlir::Value translation layer
1273 
1274 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1275                                    mlir::Location loc) {
1276   assert(val && "optional unhandled here");
1277   mlir::Type type = val.getType();
1278   mlir::Value base = val;
1279   mlir::IndexType indexType = builder.getIndexType();
1280   llvm::SmallVector<mlir::Value> extents;
1281 
1282   fir::factory::CharacterExprHelper charHelper{builder, loc};
1283   // FIXME: we may want to allow non character scalar here.
1284   if (charHelper.isCharacterScalar(type))
1285     return charHelper.toExtendedValue(val);
1286 
1287   if (auto refType = type.dyn_cast<fir::ReferenceType>())
1288     type = refType.getEleTy();
1289 
1290   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
1291     type = arrayType.getEleTy();
1292     for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1293       if (extent == fir::SequenceType::getUnknownExtent())
1294         break;
1295       extents.emplace_back(
1296           builder.createIntegerConstant(loc, indexType, extent));
1297     }
1298     // Last extent might be missing in case of assumed-size. If more extents
1299     // could not be deduced from type, that's an error (a fir.box should
1300     // have been used in the interface).
1301     if (extents.size() + 1 < arrayType.getShape().size())
1302       mlir::emitError(loc, "cannot retrieve array extents from type");
1303   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
1304     fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1305   }
1306 
1307   if (!extents.empty())
1308     return fir::ArrayBoxValue{base, extents};
1309   return base;
1310 }
1311 
1312 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1313                     mlir::Location loc) {
1314   if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1315     mlir::Value buffer = charBox->getBuffer();
1316     if (buffer.getType().isa<fir::BoxCharType>())
1317       return buffer;
1318     return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1319         buffer, charBox->getLen());
1320   }
1321 
1322   // FIXME: need to access other ExtendedValue variants and handle them
1323   // properly.
1324   return fir::getBase(val);
1325 }
1326 
1327 //===----------------------------------------------------------------------===//
1328 // IntrinsicLibrary
1329 //===----------------------------------------------------------------------===//
1330 
1331 /// Emit a TODO error message for as yet unimplemented intrinsics.
1332 static void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
1333   TODO(loc, "missing intrinsic lowering: " + llvm::Twine(name));
1334 }
1335 
1336 template <typename GeneratorType>
1337 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
1338     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
1339     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1340   llvm::SmallVector<mlir::Value> scalarArgs;
1341   for (const fir::ExtendedValue &arg : args)
1342     if (arg.getUnboxed() || arg.getCharBox())
1343       scalarArgs.emplace_back(fir::getBase(arg));
1344     else
1345       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1346   return invokeGenerator(generator, resultType, scalarArgs);
1347 }
1348 
1349 template <>
1350 fir::ExtendedValue
1351 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
1352     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
1353     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1354   for (const fir::ExtendedValue &arg : args)
1355     if (!arg.getUnboxed() && !arg.getCharBox())
1356       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1357   if (outline)
1358     return outlineInExtendedWrapper(generator, name, resultType, args);
1359   return std::invoke(generator, *this, resultType, args);
1360 }
1361 
1362 template <>
1363 fir::ExtendedValue
1364 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
1365     SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
1366     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1367   for (const fir::ExtendedValue &arg : args)
1368     if (!arg.getUnboxed() && !arg.getCharBox())
1369       // fir::emitFatalError(loc, "nonscalar intrinsic argument");
1370       crashOnMissingIntrinsic(loc, name);
1371   if (outline)
1372     return outlineInExtendedWrapper(generator, name, resultType, args);
1373   std::invoke(generator, *this, args);
1374   return mlir::Value();
1375 }
1376 
1377 static fir::ExtendedValue
1378 invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
1379               const IntrinsicHandler &handler,
1380               llvm::Optional<mlir::Type> resultType,
1381               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1382               IntrinsicLibrary &lib) {
1383   assert(resultType && "expect elemental intrinsic to be functions");
1384   return lib.genElementalCall(generator, handler.name, *resultType, args,
1385                               outline);
1386 }
1387 
1388 static fir::ExtendedValue
1389 invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
1390               const IntrinsicHandler &handler,
1391               llvm::Optional<mlir::Type> resultType,
1392               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1393               IntrinsicLibrary &lib) {
1394   assert(resultType && "expect intrinsic function");
1395   if (handler.isElemental)
1396     return lib.genElementalCall(generator, handler.name, *resultType, args,
1397                                 outline);
1398   if (outline)
1399     return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
1400                                         args);
1401   return std::invoke(generator, lib, *resultType, args);
1402 }
1403 
1404 static fir::ExtendedValue
1405 invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
1406               const IntrinsicHandler &handler,
1407               llvm::Optional<mlir::Type> resultType,
1408               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1409               IntrinsicLibrary &lib) {
1410   if (handler.isElemental)
1411     return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
1412                                 outline);
1413   if (outline)
1414     return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
1415                                         args);
1416   std::invoke(generator, lib, args);
1417   return mlir::Value{};
1418 }
1419 
1420 fir::ExtendedValue
1421 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name,
1422                                    llvm::Optional<mlir::Type> resultType,
1423                                    llvm::ArrayRef<fir::ExtendedValue> args) {
1424   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
1425     bool outline = handler->outline || outlineAllIntrinsics;
1426     return std::visit(
1427         [&](auto &generator) -> fir::ExtendedValue {
1428           return invokeHandler(generator, *handler, resultType, args, outline,
1429                                *this);
1430         },
1431         handler->generator);
1432   }
1433 
1434   if (!resultType)
1435     // Subroutine should have a handler, they are likely missing for now.
1436     crashOnMissingIntrinsic(loc, name);
1437 
1438   // Try the runtime if no special handler was defined for the
1439   // intrinsic being called. Maths runtime only has numerical elemental.
1440   // No optional arguments are expected at this point, the code will
1441   // crash if it gets absent optional.
1442 
1443   // FIXME: using toValue to get the type won't work with array arguments.
1444   llvm::SmallVector<mlir::Value> mlirArgs;
1445   for (const fir::ExtendedValue &extendedVal : args) {
1446     mlir::Value val = toValue(extendedVal, builder, loc);
1447     if (!val)
1448       // If an absent optional gets there, most likely its handler has just
1449       // not yet been defined.
1450       crashOnMissingIntrinsic(loc, name);
1451     mlirArgs.emplace_back(val);
1452   }
1453   mlir::FunctionType soughtFuncType =
1454       getFunctionType(*resultType, mlirArgs, builder);
1455 
1456   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
1457       getRuntimeCallGenerator(name, soughtFuncType);
1458   return genElementalCall(runtimeCallGenerator, name, *resultType, args,
1459                           /* outline */ true);
1460 }
1461 
1462 mlir::Value
1463 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
1464                                   mlir::Type resultType,
1465                                   llvm::ArrayRef<mlir::Value> args) {
1466   return std::invoke(generator, *this, resultType, args);
1467 }
1468 
1469 mlir::Value
1470 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
1471                                   mlir::Type resultType,
1472                                   llvm::ArrayRef<mlir::Value> args) {
1473   return generator(builder, loc, args);
1474 }
1475 
1476 mlir::Value
1477 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
1478                                   mlir::Type resultType,
1479                                   llvm::ArrayRef<mlir::Value> args) {
1480   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1481   for (mlir::Value arg : args)
1482     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1483   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
1484   return toValue(extendedResult, builder, loc);
1485 }
1486 
1487 mlir::Value
1488 IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
1489                                   llvm::ArrayRef<mlir::Value> args) {
1490   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1491   for (mlir::Value arg : args)
1492     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1493   std::invoke(generator, *this, extendedArgs);
1494   return {};
1495 }
1496 
1497 template <typename GeneratorType>
1498 mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
1499                                           llvm::StringRef name,
1500                                           mlir::FunctionType funcType,
1501                                           bool loadRefArguments) {
1502   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
1503   mlir::FuncOp function = builder.getNamedFunction(wrapperName);
1504   if (!function) {
1505     // First time this wrapper is needed, build it.
1506     function = builder.createFunction(loc, wrapperName, funcType);
1507     function->setAttr("fir.intrinsic", builder.getUnitAttr());
1508     auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
1509     auto linkage =
1510         mlir::LLVM::LinkageAttr::get(builder.getContext(), internalLinkage);
1511     function->setAttr("llvm.linkage", linkage);
1512     function.addEntryBlock();
1513 
1514     // Create local context to emit code into the newly created function
1515     // This new function is not linked to a source file location, only
1516     // its calls will be.
1517     auto localBuilder =
1518         std::make_unique<fir::FirOpBuilder>(function, builder.getKindMap());
1519     localBuilder->setInsertionPointToStart(&function.front());
1520     // Location of code inside wrapper of the wrapper is independent from
1521     // the location of the intrinsic call.
1522     mlir::Location localLoc = localBuilder->getUnknownLoc();
1523     llvm::SmallVector<mlir::Value> localArguments;
1524     for (mlir::BlockArgument bArg : function.front().getArguments()) {
1525       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
1526       if (loadRefArguments && refType) {
1527         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
1528         localArguments.push_back(loaded);
1529       } else {
1530         localArguments.push_back(bArg);
1531       }
1532     }
1533 
1534     IntrinsicLibrary localLib{*localBuilder, localLoc};
1535 
1536     if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
1537       localLib.invokeGenerator(generator, localArguments);
1538       localBuilder->create<mlir::func::ReturnOp>(localLoc);
1539     } else {
1540       assert(funcType.getNumResults() == 1 &&
1541              "expect one result for intrinsic function wrapper type");
1542       mlir::Type resultType = funcType.getResult(0);
1543       auto result =
1544           localLib.invokeGenerator(generator, resultType, localArguments);
1545       localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
1546     }
1547   } else {
1548     // Wrapper was already built, ensure it has the sought type
1549     assert(function.getFunctionType() == funcType &&
1550            "conflict between intrinsic wrapper types");
1551   }
1552   return function;
1553 }
1554 
1555 /// Helpers to detect absent optional (not yet supported in outlining).
1556 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
1557   for (const fir::ExtendedValue &arg : args)
1558     if (!fir::getBase(arg))
1559       return true;
1560   return false;
1561 }
1562 
1563 template <typename GeneratorType>
1564 fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
1565     GeneratorType generator, llvm::StringRef name,
1566     llvm::Optional<mlir::Type> resultType,
1567     llvm::ArrayRef<fir::ExtendedValue> args) {
1568   if (hasAbsentOptional(args))
1569     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1570                   " with absent optional argument");
1571   llvm::SmallVector<mlir::Value> mlirArgs;
1572   for (const auto &extendedVal : args)
1573     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
1574   mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
1575   mlir::FuncOp wrapper = getWrapper(generator, name, funcType);
1576   auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
1577   if (resultType)
1578     return toExtendedValue(call.getResult(0), builder, loc);
1579   // Subroutine calls
1580   return mlir::Value{};
1581 }
1582 
1583 IntrinsicLibrary::RuntimeCallGenerator
1584 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
1585                                           mlir::FunctionType soughtFuncType) {
1586   mlir::FuncOp funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType);
1587   if (!funcOp) {
1588     std::string buffer("not yet implemented: missing intrinsic lowering: ");
1589     llvm::raw_string_ostream sstream(buffer);
1590     sstream << name << "\nrequested type was: " << soughtFuncType << '\n';
1591     fir::emitFatalError(loc, buffer);
1592   }
1593 
1594   mlir::FunctionType actualFuncType = funcOp.getFunctionType();
1595   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
1596          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
1597          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
1598 
1599   return [funcOp, actualFuncType,
1600           soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
1601                           llvm::ArrayRef<mlir::Value> args) {
1602     llvm::SmallVector<mlir::Value> convertedArguments;
1603     for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
1604       convertedArguments.push_back(builder.createConvert(loc, fst, snd));
1605     auto call = builder.create<fir::CallOp>(loc, funcOp, convertedArguments);
1606     mlir::Type soughtType = soughtFuncType.getResult(0);
1607     return builder.createConvert(loc, soughtType, call.getResult(0));
1608   };
1609 }
1610 
1611 void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
1612   assert(stmtCtx);
1613   fir::FirOpBuilder *bldr = &builder;
1614   stmtCtx->attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
1615 }
1616 
1617 fir::ExtendedValue
1618 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
1619                                     mlir::Type resultType,
1620                                     llvm::StringRef intrinsicName) {
1621   fir::ExtendedValue res =
1622       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
1623   return res.match(
1624       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
1625         // Add cleanup code
1626         addCleanUpForTemp(loc, box.getAddr());
1627         return box;
1628       },
1629       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
1630         // Add cleanup code
1631         auto addr =
1632             builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
1633         addCleanUpForTemp(loc, addr);
1634         return box;
1635       },
1636       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
1637         // Add cleanup code
1638         addCleanUpForTemp(loc, box.getAddr());
1639         return box;
1640       },
1641       [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
1642         // Add cleanup code
1643         addCleanUpForTemp(loc, tempAddr);
1644         return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
1645       },
1646       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
1647         // Add cleanup code
1648         addCleanUpForTemp(loc, box.getAddr());
1649         return box;
1650       },
1651       [&](const auto &) -> fir::ExtendedValue {
1652         fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
1653       });
1654 }
1655 
1656 //===----------------------------------------------------------------------===//
1657 // Code generators for the intrinsic
1658 //===----------------------------------------------------------------------===//
1659 
1660 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
1661                                              mlir::Type resultType,
1662                                              llvm::ArrayRef<mlir::Value> args) {
1663   mlir::FunctionType soughtFuncType =
1664       getFunctionType(resultType, args, builder);
1665   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
1666 }
1667 
1668 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
1669                                             llvm::ArrayRef<mlir::Value> args) {
1670   // There can be an optional kind in second argument.
1671   assert(args.size() >= 1);
1672   return builder.convertWithSemantics(loc, resultType, args[0]);
1673 }
1674 
1675 // ABS
1676 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
1677                                      llvm::ArrayRef<mlir::Value> args) {
1678   assert(args.size() == 1);
1679   mlir::Value arg = args[0];
1680   mlir::Type type = arg.getType();
1681   if (fir::isa_real(type)) {
1682     // Runtime call to fp abs. An alternative would be to use mlir
1683     // math::AbsFOp but it does not support all fir floating point types.
1684     return genRuntimeCall("abs", resultType, args);
1685   }
1686   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
1687     // At the time of this implementation there is no abs op in mlir.
1688     // So, implement abs here without branching.
1689     mlir::Value shift =
1690         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
1691     auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
1692     auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
1693     return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
1694   }
1695   if (fir::isa_complex(type)) {
1696     // Use HYPOT to fulfill the no underflow/overflow requirement.
1697     auto parts = fir::factory::Complex{builder, loc}.extractParts(arg);
1698     llvm::SmallVector<mlir::Value> args = {parts.first, parts.second};
1699     return genRuntimeCall("hypot", resultType, args);
1700   }
1701   llvm_unreachable("unexpected type in ABS argument");
1702 }
1703 
1704 // ADJUSTL & ADJUSTR
1705 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
1706                               mlir::Value, mlir::Value)>
1707 fir::ExtendedValue
1708 IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
1709                                   llvm::ArrayRef<fir::ExtendedValue> args) {
1710   assert(args.size() == 1);
1711   mlir::Value string = builder.createBox(loc, args[0]);
1712   // Create a mutable fir.box to be passed to the runtime for the result.
1713   fir::MutableBoxValue resultMutableBox =
1714       fir::factory::createTempMutableBox(builder, loc, resultType);
1715   mlir::Value resultIrBox =
1716       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
1717 
1718   // Call the runtime -- the runtime will allocate the result.
1719   CallRuntime(builder, loc, resultIrBox, string);
1720 
1721   // Read result from mutable fir.box and add it to the list of temps to be
1722   // finalized by the StatementContext.
1723   fir::ExtendedValue res =
1724       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
1725   return res.match(
1726       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
1727         addCleanUpForTemp(loc, fir::getBase(box));
1728         return box;
1729       },
1730       [&](const auto &) -> fir::ExtendedValue {
1731         fir::emitFatalError(loc, "result of ADJUSTL is not a scalar character");
1732       });
1733 }
1734 
1735 // AIMAG
1736 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
1737                                        llvm::ArrayRef<mlir::Value> args) {
1738   assert(args.size() == 1);
1739   return fir::factory::Complex{builder, loc}.extractComplexPart(
1740       args[0], true /* isImagPart */);
1741 }
1742 
1743 // AINT
1744 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
1745                                       llvm::ArrayRef<mlir::Value> args) {
1746   assert(args.size() >= 1 && args.size() <= 2);
1747   // Skip optional kind argument to search the runtime; it is already reflected
1748   // in result type.
1749   return genRuntimeCall("aint", resultType, {args[0]});
1750 }
1751 
1752 // ALL
1753 fir::ExtendedValue
1754 IntrinsicLibrary::genAll(mlir::Type resultType,
1755                          llvm::ArrayRef<fir::ExtendedValue> args) {
1756 
1757   assert(args.size() == 2);
1758   // Handle required mask argument
1759   mlir::Value mask = builder.createBox(loc, args[0]);
1760 
1761   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
1762   int rank = maskArry.rank();
1763   assert(rank >= 1);
1764 
1765   // Handle optional dim argument
1766   bool absentDim = isAbsent(args[1]);
1767   mlir::Value dim =
1768       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
1769                 : fir::getBase(args[1]);
1770 
1771   if (rank == 1 || absentDim)
1772     return builder.createConvert(loc, resultType,
1773                                  fir::runtime::genAll(builder, loc, mask, dim));
1774 
1775   // else use the result descriptor AllDim() intrinsic
1776 
1777   // Create mutable fir.box to be passed to the runtime for the result.
1778 
1779   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
1780   fir::MutableBoxValue resultMutableBox =
1781       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
1782   mlir::Value resultIrBox =
1783       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
1784 
1785   // Call runtime. The runtime is allocating the result.
1786   fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
1787   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
1788       .match(
1789           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
1790             addCleanUpForTemp(loc, box.getAddr());
1791             return box;
1792           },
1793           [&](const auto &) -> fir::ExtendedValue {
1794             fir::emitFatalError(loc, "Invalid result for ALL");
1795           });
1796 }
1797 
1798 // ALLOCATED
1799 fir::ExtendedValue
1800 IntrinsicLibrary::genAllocated(mlir::Type resultType,
1801                                llvm::ArrayRef<fir::ExtendedValue> args) {
1802   assert(args.size() == 1);
1803   return args[0].match(
1804       [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
1805         return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
1806       },
1807       [&](const auto &) -> fir::ExtendedValue {
1808         fir::emitFatalError(loc,
1809                             "allocated arg not lowered to MutableBoxValue");
1810       });
1811 }
1812 
1813 // ANINT
1814 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
1815                                        llvm::ArrayRef<mlir::Value> args) {
1816   assert(args.size() >= 1 && args.size() <= 2);
1817   // Skip optional kind argument to search the runtime; it is already reflected
1818   // in result type.
1819   return genRuntimeCall("anint", resultType, {args[0]});
1820 }
1821 
1822 // ANY
1823 fir::ExtendedValue
1824 IntrinsicLibrary::genAny(mlir::Type resultType,
1825                          llvm::ArrayRef<fir::ExtendedValue> args) {
1826 
1827   assert(args.size() == 2);
1828   // Handle required mask argument
1829   mlir::Value mask = builder.createBox(loc, args[0]);
1830 
1831   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
1832   int rank = maskArry.rank();
1833   assert(rank >= 1);
1834 
1835   // Handle optional dim argument
1836   bool absentDim = isAbsent(args[1]);
1837   mlir::Value dim =
1838       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
1839                 : fir::getBase(args[1]);
1840 
1841   if (rank == 1 || absentDim)
1842     return builder.createConvert(loc, resultType,
1843                                  fir::runtime::genAny(builder, loc, mask, dim));
1844 
1845   // else use the result descriptor AnyDim() intrinsic
1846 
1847   // Create mutable fir.box to be passed to the runtime for the result.
1848 
1849   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
1850   fir::MutableBoxValue resultMutableBox =
1851       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
1852   mlir::Value resultIrBox =
1853       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
1854 
1855   // Call runtime. The runtime is allocating the result.
1856   fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
1857   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
1858       .match(
1859           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
1860             addCleanUpForTemp(loc, box.getAddr());
1861             return box;
1862           },
1863           [&](const auto &) -> fir::ExtendedValue {
1864             fir::emitFatalError(loc, "Invalid result for ANY");
1865           });
1866 }
1867 
1868 // ASSOCIATED
1869 fir::ExtendedValue
1870 IntrinsicLibrary::genAssociated(mlir::Type resultType,
1871                                 llvm::ArrayRef<fir::ExtendedValue> args) {
1872   assert(args.size() == 2);
1873   auto *pointer =
1874       args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
1875                     [&](const auto &) -> const fir::MutableBoxValue * {
1876                       fir::emitFatalError(loc, "pointer not a MutableBoxValue");
1877                     });
1878   const fir::ExtendedValue &target = args[1];
1879   if (isAbsent(target))
1880     return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
1881 
1882   mlir::Value targetBox = builder.createBox(loc, target);
1883   if (fir::valueHasFirAttribute(fir::getBase(target),
1884                                 fir::getOptionalAttrName())) {
1885     // Subtle: contrary to other intrinsic optional arguments, disassociated
1886     // POINTER and unallocated ALLOCATABLE actual argument are not considered
1887     // absent here. This is because ASSOCIATED has special requirements for
1888     // TARGET actual arguments that are POINTERs. There is no precise
1889     // requirements for ALLOCATABLEs, but all existing Fortran compilers treat
1890     // them similarly to POINTERs. That is: unallocated TARGETs cause ASSOCIATED
1891     // to rerun false.  The runtime deals with the disassociated/unallocated
1892     // case. Simply ensures that TARGET that are OPTIONAL get conditionally
1893     // emboxed here to convey the optional aspect to the runtime.
1894     auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
1895                                                       fir::getBase(target));
1896     auto absentBox = builder.create<fir::AbsentOp>(loc, targetBox.getType());
1897     targetBox = builder.create<mlir::arith::SelectOp>(loc, isPresent, targetBox,
1898                                                       absentBox);
1899   }
1900   mlir::Value pointerBoxRef =
1901       fir::factory::getMutableIRBox(builder, loc, *pointer);
1902   auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
1903   return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
1904 }
1905 
1906 // BTEST
1907 mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
1908                                        llvm::ArrayRef<mlir::Value> args) {
1909   // A conformant BTEST(I,POS) call satisfies:
1910   //     POS >= 0
1911   //     POS < BIT_SIZE(I)
1912   // Return:  (I >> POS) & 1
1913   assert(args.size() == 2);
1914   mlir::Type argType = args[0].getType();
1915   mlir::Value pos = builder.createConvert(loc, argType, args[1]);
1916   auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
1917   mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
1918   auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
1919   return builder.createConvert(loc, resultType, res);
1920 }
1921 
1922 // CEILING
1923 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
1924                                          llvm::ArrayRef<mlir::Value> args) {
1925   // Optional KIND argument.
1926   assert(args.size() >= 1);
1927   mlir::Value arg = args[0];
1928   // Use ceil that is not an actual Fortran intrinsic but that is
1929   // an llvm intrinsic that does the same, but return a floating
1930   // point.
1931   mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
1932   return builder.createConvert(loc, resultType, ceil);
1933 }
1934 
1935 // CHAR
1936 fir::ExtendedValue
1937 IntrinsicLibrary::genChar(mlir::Type type,
1938                           llvm::ArrayRef<fir::ExtendedValue> args) {
1939   // Optional KIND argument.
1940   assert(args.size() >= 1);
1941   const mlir::Value *arg = args[0].getUnboxed();
1942   // expect argument to be a scalar integer
1943   if (!arg)
1944     mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
1945   fir::factory::CharacterExprHelper helper{builder, loc};
1946   fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
1947   mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
1948   mlir::Value len =
1949       builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
1950   return fir::CharBoxValue{cast, len};
1951 }
1952 
1953 // CMPLX
1954 mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
1955                                        llvm::ArrayRef<mlir::Value> args) {
1956   assert(args.size() >= 1);
1957   fir::factory::Complex complexHelper(builder, loc);
1958   mlir::Type partType = complexHelper.getComplexPartType(resultType);
1959   mlir::Value real = builder.createConvert(loc, partType, args[0]);
1960   mlir::Value imag = isAbsent(args, 1)
1961                          ? builder.createRealZeroConstant(loc, partType)
1962                          : builder.createConvert(loc, partType, args[1]);
1963   return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
1964                                                            imag);
1965 }
1966 
1967 // COMMAND_ARGUMENT_COUNT
1968 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
1969     mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
1970   assert(args.size() == 0);
1971   assert(resultType == builder.getDefaultIntegerType() &&
1972          "result type is not default integer kind type");
1973   return builder.createConvert(
1974       loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
1975   ;
1976 }
1977 
1978 // CONJG
1979 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
1980                                        llvm::ArrayRef<mlir::Value> args) {
1981   assert(args.size() == 1);
1982   if (resultType != args[0].getType())
1983     llvm_unreachable("argument type mismatch");
1984 
1985   mlir::Value cplx = args[0];
1986   auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
1987       cplx, /*isImagPart=*/true);
1988   auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
1989   return fir::factory::Complex{builder, loc}.insertComplexPart(
1990       cplx, negImag, /*isImagPart=*/true);
1991 }
1992 
1993 // COUNT
1994 fir::ExtendedValue
1995 IntrinsicLibrary::genCount(mlir::Type resultType,
1996                            llvm::ArrayRef<fir::ExtendedValue> args) {
1997   assert(args.size() == 3);
1998 
1999   // Handle mask argument
2000   fir::BoxValue mask = builder.createBox(loc, args[0]);
2001   unsigned maskRank = mask.rank();
2002 
2003   assert(maskRank > 0);
2004 
2005   // Handle optional dim argument
2006   bool absentDim = isAbsent(args[1]);
2007   mlir::Value dim =
2008       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
2009                 : fir::getBase(args[1]);
2010 
2011   if (absentDim || maskRank == 1) {
2012     // Result is scalar if no dim argument or mask is rank 1.
2013     // So, call specialized Count runtime routine.
2014     return builder.createConvert(
2015         loc, resultType,
2016         fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
2017   }
2018 
2019   // Call general CountDim runtime routine.
2020 
2021   // Handle optional kind argument
2022   bool absentKind = isAbsent(args[2]);
2023   mlir::Value kind = absentKind ? builder.createIntegerConstant(
2024                                       loc, builder.getIndexType(),
2025                                       builder.getKindMap().defaultIntegerKind())
2026                                 : fir::getBase(args[2]);
2027 
2028   // Create mutable fir.box to be passed to the runtime for the result.
2029   mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
2030   fir::MutableBoxValue resultMutableBox =
2031       fir::factory::createTempMutableBox(builder, loc, type);
2032 
2033   mlir::Value resultIrBox =
2034       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2035 
2036   fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
2037                             kind);
2038 
2039   // Handle cleanup of allocatable result descriptor and return
2040   fir::ExtendedValue res =
2041       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2042   return res.match(
2043       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2044         // Add cleanup code
2045         addCleanUpForTemp(loc, box.getAddr());
2046         return box;
2047       },
2048       [&](const auto &) -> fir::ExtendedValue {
2049         fir::emitFatalError(loc, "unexpected result for COUNT");
2050       });
2051 }
2052 
2053 // CPU_TIME
2054 void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2055   assert(args.size() == 1);
2056   const mlir::Value *arg = args[0].getUnboxed();
2057   assert(arg && "nonscalar cpu_time argument");
2058   mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
2059   mlir::Value res2 =
2060       builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
2061   builder.create<fir::StoreOp>(loc, res2, *arg);
2062 }
2063 
2064 // CSHIFT
2065 fir::ExtendedValue
2066 IntrinsicLibrary::genCshift(mlir::Type resultType,
2067                             llvm::ArrayRef<fir::ExtendedValue> args) {
2068   assert(args.size() == 3);
2069 
2070   // Handle required ARRAY argument
2071   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2072   mlir::Value array = fir::getBase(arrayBox);
2073   unsigned arrayRank = arrayBox.rank();
2074 
2075   // Create mutable fir.box to be passed to the runtime for the result.
2076   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2077   fir::MutableBoxValue resultMutableBox =
2078       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2079   mlir::Value resultIrBox =
2080       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2081 
2082   if (arrayRank == 1) {
2083     // Vector case
2084     // Handle required SHIFT argument as a scalar
2085     const mlir::Value *shiftAddr = args[1].getUnboxed();
2086     assert(shiftAddr && "nonscalar CSHIFT argument");
2087     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2088 
2089     fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
2090   } else {
2091     // Non-vector case
2092     // Handle required SHIFT argument as an array
2093     mlir::Value shift = builder.createBox(loc, args[1]);
2094 
2095     // Handle optional DIM argument
2096     mlir::Value dim =
2097         isAbsent(args[2])
2098             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2099             : fir::getBase(args[2]);
2100     fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
2101   }
2102   return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
2103 }
2104 
2105 // DATE_AND_TIME
2106 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2107   assert(args.size() == 4 && "date_and_time has 4 args");
2108   llvm::SmallVector<llvm::Optional<fir::CharBoxValue>> charArgs(3);
2109   for (unsigned i = 0; i < 3; ++i)
2110     if (const fir::CharBoxValue *charBox = args[i].getCharBox())
2111       charArgs[i] = *charBox;
2112 
2113   mlir::Value values = fir::getBase(args[3]);
2114   if (!values)
2115     values = builder.create<fir::AbsentOp>(
2116         loc, fir::BoxType::get(builder.getNoneType()));
2117 
2118   Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
2119                                  charArgs[2], values);
2120 }
2121 
2122 // DIM
2123 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
2124                                      llvm::ArrayRef<mlir::Value> args) {
2125   assert(args.size() == 2);
2126   if (resultType.isa<mlir::IntegerType>()) {
2127     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2128     auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
2129     auto cmp = builder.create<mlir::arith::CmpIOp>(
2130         loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
2131     return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2132   }
2133   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
2134   mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
2135   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
2136   auto cmp = builder.create<mlir::arith::CmpFOp>(
2137       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
2138   return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2139 }
2140 
2141 // DPROD
2142 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
2143                                        llvm::ArrayRef<mlir::Value> args) {
2144   assert(args.size() == 2);
2145   assert(fir::isa_real(resultType) &&
2146          "Result must be double precision in DPROD");
2147   mlir::Value a = builder.createConvert(loc, resultType, args[0]);
2148   mlir::Value b = builder.createConvert(loc, resultType, args[1]);
2149   return builder.create<mlir::arith::MulFOp>(loc, a, b);
2150 }
2151 
2152 // DOT_PRODUCT
2153 fir::ExtendedValue
2154 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
2155                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2156   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
2157                     stmtCtx, args);
2158 }
2159 
2160 // EOSHIFT
2161 fir::ExtendedValue
2162 IntrinsicLibrary::genEoshift(mlir::Type resultType,
2163                              llvm::ArrayRef<fir::ExtendedValue> args) {
2164   assert(args.size() == 4);
2165 
2166   // Handle required ARRAY argument
2167   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2168   mlir::Value array = fir::getBase(arrayBox);
2169   unsigned arrayRank = arrayBox.rank();
2170 
2171   // Create mutable fir.box to be passed to the runtime for the result.
2172   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2173   fir::MutableBoxValue resultMutableBox =
2174       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2175   mlir::Value resultIrBox =
2176       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2177 
2178   // Handle optional BOUNDARY argument
2179   mlir::Value boundary =
2180       isAbsent(args[2]) ? builder.create<fir::AbsentOp>(
2181                               loc, fir::BoxType::get(builder.getNoneType()))
2182                         : builder.createBox(loc, args[2]);
2183 
2184   if (arrayRank == 1) {
2185     // Vector case
2186     // Handle required SHIFT argument as a scalar
2187     const mlir::Value *shiftAddr = args[1].getUnboxed();
2188     assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
2189     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2190     fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
2191                                    boundary);
2192   } else {
2193     // Non-vector case
2194     // Handle required SHIFT argument as an array
2195     mlir::Value shift = builder.createBox(loc, args[1]);
2196 
2197     // Handle optional DIM argument
2198     mlir::Value dim =
2199         isAbsent(args[3])
2200             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2201             : fir::getBase(args[3]);
2202     fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
2203                              dim);
2204   }
2205   return readAndAddCleanUp(resultMutableBox, resultType,
2206                            "unexpected result for EOSHIFT");
2207 }
2208 
2209 // EXIT
2210 void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
2211   assert(args.size() == 1);
2212 
2213   mlir::Value status =
2214       isAbsent(args[0])
2215           ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
2216                                           EXIT_SUCCESS)
2217           : fir::getBase(args[0]);
2218 
2219   assert(status.getType() == builder.getDefaultIntegerType() &&
2220          "STATUS parameter must be an INTEGER of default kind");
2221 
2222   fir::runtime::genExit(builder, loc, status);
2223 }
2224 
2225 // EXPONENT
2226 mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
2227                                           llvm::ArrayRef<mlir::Value> args) {
2228   assert(args.size() == 1);
2229 
2230   return builder.createConvert(
2231       loc, resultType,
2232       fir::runtime::genExponent(builder, loc, resultType,
2233                                 fir::getBase(args[0])));
2234 }
2235 
2236 // FLOOR
2237 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
2238                                        llvm::ArrayRef<mlir::Value> args) {
2239   // Optional KIND argument.
2240   assert(args.size() >= 1);
2241   mlir::Value arg = args[0];
2242   // Use LLVM floor that returns real.
2243   mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
2244   return builder.createConvert(loc, resultType, floor);
2245 }
2246 
2247 // FRACTION
2248 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
2249                                           llvm::ArrayRef<mlir::Value> args) {
2250   assert(args.size() == 1);
2251 
2252   return builder.createConvert(
2253       loc, resultType,
2254       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
2255 }
2256 
2257 // GET_COMMAND_ARGUMENT
2258 void IntrinsicLibrary::genGetCommandArgument(
2259     llvm::ArrayRef<fir::ExtendedValue> args) {
2260   assert(args.size() == 5);
2261 
2262   auto processCharBox = [&](llvm::Optional<fir::CharBoxValue> arg,
2263                             mlir::Value &value) -> void {
2264     if (arg.hasValue()) {
2265       value = builder.createBox(loc, *arg);
2266     } else {
2267       value = builder
2268                   .create<fir::AbsentOp>(
2269                       loc, fir::BoxType::get(builder.getNoneType()))
2270                   .getResult();
2271     }
2272   };
2273 
2274   // Handle NUMBER argument
2275   mlir::Value number = fir::getBase(args[0]);
2276   if (!number)
2277     fir::emitFatalError(loc, "expected NUMBER parameter");
2278 
2279   // Handle optional VALUE argument
2280   mlir::Value value;
2281   llvm::Optional<fir::CharBoxValue> valBox;
2282   if (const fir::CharBoxValue *charBox = args[1].getCharBox())
2283     valBox = *charBox;
2284   processCharBox(valBox, value);
2285 
2286   // Handle optional LENGTH argument
2287   mlir::Value length = fir::getBase(args[2]);
2288 
2289   // Handle optional STATUS argument
2290   mlir::Value status = fir::getBase(args[3]);
2291 
2292   // Handle optional ERRMSG argument
2293   mlir::Value errmsg;
2294   llvm::Optional<fir::CharBoxValue> errmsgBox;
2295   if (const fir::CharBoxValue *charBox = args[4].getCharBox())
2296     errmsgBox = *charBox;
2297   processCharBox(errmsgBox, errmsg);
2298 
2299   fir::runtime::genGetCommandArgument(builder, loc, number, value, length,
2300                                       status, errmsg);
2301 }
2302 
2303 // GET_ENVIRONMENT_VARIABLE
2304 void IntrinsicLibrary::genGetEnvironmentVariable(
2305     llvm::ArrayRef<fir::ExtendedValue> args) {
2306   assert(args.size() == 6);
2307 
2308   auto processCharBox = [&](llvm::Optional<fir::CharBoxValue> arg,
2309                             mlir::Value &value) -> void {
2310     if (arg.hasValue()) {
2311       value = builder.createBox(loc, *arg);
2312     } else {
2313       value = builder
2314                   .create<fir::AbsentOp>(
2315                       loc, fir::BoxType::get(builder.getNoneType()))
2316                   .getResult();
2317     }
2318   };
2319 
2320   // Handle NAME argument
2321   mlir::Value name;
2322   if (const fir::CharBoxValue *charBox = args[0].getCharBox()) {
2323     llvm::Optional<fir::CharBoxValue> nameBox = *charBox;
2324     assert(nameBox.hasValue());
2325     name = builder.createBox(loc, *nameBox);
2326   }
2327 
2328   // Handle optional VALUE argument
2329   mlir::Value value;
2330   llvm::Optional<fir::CharBoxValue> valBox;
2331   if (const fir::CharBoxValue *charBox = args[1].getCharBox())
2332     valBox = *charBox;
2333   processCharBox(valBox, value);
2334 
2335   // Handle optional LENGTH argument
2336   mlir::Value length = fir::getBase(args[2]);
2337 
2338   // Handle optional STATUS argument
2339   mlir::Value status = fir::getBase(args[3]);
2340 
2341   // Handle optional TRIM_NAME argument
2342   mlir::Value trim_name =
2343       isAbsent(args[4]) ? builder.createBool(loc, true) : fir::getBase(args[4]);
2344 
2345   // Handle optional ERRMSG argument
2346   mlir::Value errmsg;
2347   llvm::Optional<fir::CharBoxValue> errmsgBox;
2348   if (const fir::CharBoxValue *charBox = args[5].getCharBox())
2349     errmsgBox = *charBox;
2350   processCharBox(errmsgBox, errmsg);
2351 
2352   fir::runtime::genGetEnvironmentVariable(builder, loc, name, value, length,
2353                                           status, trim_name, errmsg);
2354 }
2355 
2356 // IAND
2357 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
2358                                       llvm::ArrayRef<mlir::Value> args) {
2359   assert(args.size() == 2);
2360   return builder.create<mlir::arith::AndIOp>(loc, args[0], args[1]);
2361 }
2362 
2363 // IBCLR
2364 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
2365                                        llvm::ArrayRef<mlir::Value> args) {
2366   // A conformant IBCLR(I,POS) call satisfies:
2367   //     POS >= 0
2368   //     POS < BIT_SIZE(I)
2369   // Return:  I & (!(1 << POS))
2370   assert(args.size() == 2);
2371   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2372   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
2373   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2374   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
2375   auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
2376   return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
2377 }
2378 
2379 // IBITS
2380 mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
2381                                        llvm::ArrayRef<mlir::Value> args) {
2382   // A conformant IBITS(I,POS,LEN) call satisfies:
2383   //     POS >= 0
2384   //     LEN >= 0
2385   //     POS + LEN <= BIT_SIZE(I)
2386   // Return:  LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
2387   // For a conformant call, implementing (I >> POS) with a signed or an
2388   // unsigned shift produces the same result.  For a nonconformant call,
2389   // the two choices may produce different results.
2390   assert(args.size() == 3);
2391   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2392   mlir::Value len = builder.createConvert(loc, resultType, args[2]);
2393   mlir::Value bitSize = builder.createIntegerConstant(
2394       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
2395   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
2396   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2397   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2398   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
2399   auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
2400   auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
2401   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
2402       loc, mlir::arith::CmpIPredicate::eq, len, zero);
2403   return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
2404 }
2405 
2406 // IBSET
2407 mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
2408                                        llvm::ArrayRef<mlir::Value> args) {
2409   // A conformant IBSET(I,POS) call satisfies:
2410   //     POS >= 0
2411   //     POS < BIT_SIZE(I)
2412   // Return:  I | (1 << POS)
2413   assert(args.size() == 2);
2414   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2415   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
2416   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
2417   return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
2418 }
2419 
2420 // ICHAR
2421 fir::ExtendedValue
2422 IntrinsicLibrary::genIchar(mlir::Type resultType,
2423                            llvm::ArrayRef<fir::ExtendedValue> args) {
2424   // There can be an optional kind in second argument.
2425   assert(args.size() == 2);
2426   const fir::CharBoxValue *charBox = args[0].getCharBox();
2427   if (!charBox)
2428     llvm::report_fatal_error("expected character scalar");
2429 
2430   fir::factory::CharacterExprHelper helper{builder, loc};
2431   mlir::Value buffer = charBox->getBuffer();
2432   mlir::Type bufferTy = buffer.getType();
2433   mlir::Value charVal;
2434   if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
2435     assert(charTy.singleton());
2436     charVal = buffer;
2437   } else {
2438     // Character is in memory, cast to fir.ref<char> and load.
2439     mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
2440     if (!ty)
2441       llvm::report_fatal_error("expected memory type");
2442     // The length of in the character type may be unknown. Casting
2443     // to a singleton ref is required before loading.
2444     fir::CharacterType eleType = helper.getCharacterType(ty);
2445     fir::CharacterType charType =
2446         fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
2447     mlir::Type toTy = builder.getRefType(charType);
2448     mlir::Value cast = builder.createConvert(loc, toTy, buffer);
2449     charVal = builder.create<fir::LoadOp>(loc, cast);
2450   }
2451   LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
2452   auto code = helper.extractCodeFromSingleton(charVal);
2453   return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
2454 }
2455 
2456 // IEOR
2457 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
2458                                       llvm::ArrayRef<mlir::Value> args) {
2459   assert(args.size() == 2);
2460   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
2461 }
2462 
2463 // INDEX
2464 fir::ExtendedValue
2465 IntrinsicLibrary::genIndex(mlir::Type resultType,
2466                            llvm::ArrayRef<fir::ExtendedValue> args) {
2467   assert(args.size() >= 2 && args.size() <= 4);
2468 
2469   mlir::Value stringBase = fir::getBase(args[0]);
2470   fir::KindTy kind =
2471       fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
2472           stringBase.getType());
2473   mlir::Value stringLen = fir::getLen(args[0]);
2474   mlir::Value substringBase = fir::getBase(args[1]);
2475   mlir::Value substringLen = fir::getLen(args[1]);
2476   mlir::Value back =
2477       isAbsent(args, 2)
2478           ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
2479           : fir::getBase(args[2]);
2480   if (isAbsent(args, 3))
2481     return builder.createConvert(
2482         loc, resultType,
2483         fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
2484                                substringBase, substringLen, back));
2485 
2486   // Call the descriptor-based Index implementation
2487   mlir::Value string = builder.createBox(loc, args[0]);
2488   mlir::Value substring = builder.createBox(loc, args[1]);
2489   auto makeRefThenEmbox = [&](mlir::Value b) {
2490     fir::LogicalType logTy = fir::LogicalType::get(
2491         builder.getContext(), builder.getKindMap().defaultLogicalKind());
2492     mlir::Value temp = builder.createTemporary(loc, logTy);
2493     mlir::Value castb = builder.createConvert(loc, logTy, b);
2494     builder.create<fir::StoreOp>(loc, castb, temp);
2495     return builder.createBox(loc, temp);
2496   };
2497   mlir::Value backOpt = isAbsent(args, 2)
2498                             ? builder.create<fir::AbsentOp>(
2499                                   loc, fir::BoxType::get(builder.getI1Type()))
2500                             : makeRefThenEmbox(fir::getBase(args[2]));
2501   mlir::Value kindVal = isAbsent(args, 3)
2502                             ? builder.createIntegerConstant(
2503                                   loc, builder.getIndexType(),
2504                                   builder.getKindMap().defaultIntegerKind())
2505                             : fir::getBase(args[3]);
2506   // Create mutable fir.box to be passed to the runtime for the result.
2507   fir::MutableBoxValue mutBox =
2508       fir::factory::createTempMutableBox(builder, loc, resultType);
2509   mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
2510   // Call runtime. The runtime is allocating the result.
2511   fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
2512                                    backOpt, kindVal);
2513   // Read back the result from the mutable box.
2514   return readAndAddCleanUp(mutBox, resultType, "INDEX");
2515 }
2516 
2517 // IOR
2518 mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
2519                                      llvm::ArrayRef<mlir::Value> args) {
2520   assert(args.size() == 2);
2521   return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
2522 }
2523 
2524 // ISHFT
2525 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
2526                                        llvm::ArrayRef<mlir::Value> args) {
2527   // A conformant ISHFT(I,SHIFT) call satisfies:
2528   //     abs(SHIFT) <= BIT_SIZE(I)
2529   // Return:  abs(SHIFT) >= BIT_SIZE(I)
2530   //              ? 0
2531   //              : SHIFT < 0
2532   //                    ? I >> abs(SHIFT)
2533   //                    : I << abs(SHIFT)
2534   assert(args.size() == 2);
2535   mlir::Value bitSize = builder.createIntegerConstant(
2536       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
2537   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2538   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
2539   mlir::Value absShift = genAbs(resultType, {shift});
2540   auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
2541   auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
2542   auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
2543       loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
2544   auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
2545       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
2546   auto sel =
2547       builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
2548   return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
2549 }
2550 
2551 // ISHFTC
2552 mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
2553                                         llvm::ArrayRef<mlir::Value> args) {
2554   // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
2555   //     SIZE > 0
2556   //     SIZE <= BIT_SIZE(I)
2557   //     abs(SHIFT) <= SIZE
2558   // if SHIFT > 0
2559   //     leftSize = abs(SHIFT)
2560   //     rightSize = SIZE - abs(SHIFT)
2561   // else [if SHIFT < 0]
2562   //     leftSize = SIZE - abs(SHIFT)
2563   //     rightSize = abs(SHIFT)
2564   // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
2565   // leftMaskShift = BIT_SIZE(I) - leftSize
2566   // rightMaskShift = BIT_SIZE(I) - rightSize
2567   // left = (I >> rightSize) & (-1 >> leftMaskShift)
2568   // right = (I & (-1 >> rightMaskShift)) << leftSize
2569   // Return:  SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
2570   assert(args.size() == 3);
2571   mlir::Value bitSize = builder.createIntegerConstant(
2572       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
2573   mlir::Value I = args[0];
2574   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
2575   mlir::Value size =
2576       args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
2577   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2578   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2579   mlir::Value absShift = genAbs(resultType, {shift});
2580   auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
2581   auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
2582       loc, mlir::arith::CmpIPredicate::eq, shift, zero);
2583   auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
2584       loc, mlir::arith::CmpIPredicate::eq, absShift, size);
2585   auto shiftIsNop =
2586       builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
2587   auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
2588       loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
2589   auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
2590                                                         absShift, elseSize);
2591   auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
2592                                                          elseSize, absShift);
2593   auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
2594       loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
2595   auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
2596   auto unchangedTmp2 =
2597       builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
2598   auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
2599                                                          unchangedTmp2, zero);
2600   auto leftMaskShift =
2601       builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
2602   auto leftMask =
2603       builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
2604   auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
2605   auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
2606   auto rightMaskShift =
2607       builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
2608   auto rightMask =
2609       builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
2610   auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
2611   auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
2612   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
2613   auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
2614   return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
2615 }
2616 
2617 // LEN
2618 // Note that this is only used for an unrestricted intrinsic LEN call.
2619 // Other uses of LEN are rewritten as descriptor inquiries by the front-end.
2620 fir::ExtendedValue
2621 IntrinsicLibrary::genLen(mlir::Type resultType,
2622                          llvm::ArrayRef<fir::ExtendedValue> args) {
2623   // Optional KIND argument reflected in result type and otherwise ignored.
2624   assert(args.size() == 1 || args.size() == 2);
2625   mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
2626   return builder.createConvert(loc, resultType, len);
2627 }
2628 
2629 // LEN_TRIM
2630 fir::ExtendedValue
2631 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
2632                              llvm::ArrayRef<fir::ExtendedValue> args) {
2633   // Optional KIND argument reflected in result type and otherwise ignored.
2634   assert(args.size() == 1 || args.size() == 2);
2635   const fir::CharBoxValue *charBox = args[0].getCharBox();
2636   if (!charBox)
2637     TODO(loc, "character array len_trim");
2638   auto len =
2639       fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
2640   return builder.createConvert(loc, resultType, len);
2641 }
2642 
2643 // LGE, LGT, LLE, LLT
2644 template <mlir::arith::CmpIPredicate pred>
2645 fir::ExtendedValue
2646 IntrinsicLibrary::genCharacterCompare(mlir::Type type,
2647                                       llvm::ArrayRef<fir::ExtendedValue> args) {
2648   assert(args.size() == 2);
2649   return fir::runtime::genCharCompare(
2650       builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
2651       fir::getBase(args[1]), fir::getLen(args[1]));
2652 }
2653 
2654 // MATMUL
2655 fir::ExtendedValue
2656 IntrinsicLibrary::genMatmul(mlir::Type resultType,
2657                             llvm::ArrayRef<fir::ExtendedValue> args) {
2658   assert(args.size() == 2);
2659 
2660   // Handle required matmul arguments
2661   fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
2662   mlir::Value matrixA = fir::getBase(matrixTmpA);
2663   fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
2664   mlir::Value matrixB = fir::getBase(matrixTmpB);
2665   unsigned resultRank =
2666       (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
2667 
2668   // Create mutable fir.box to be passed to the runtime for the result.
2669   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
2670   fir::MutableBoxValue resultMutableBox =
2671       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2672   mlir::Value resultIrBox =
2673       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2674   // Call runtime. The runtime is allocating the result.
2675   fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
2676   // Read result from mutable fir.box and add it to the list of temps to be
2677   // finalized by the StatementContext.
2678   return readAndAddCleanUp(resultMutableBox, resultType,
2679                            "unexpected result for MATMUL");
2680 }
2681 
2682 // Compare two FIR values and return boolean result as i1.
2683 template <Extremum extremum, ExtremumBehavior behavior>
2684 static mlir::Value createExtremumCompare(mlir::Location loc,
2685                                          fir::FirOpBuilder &builder,
2686                                          mlir::Value left, mlir::Value right) {
2687   static constexpr mlir::arith::CmpIPredicate integerPredicate =
2688       extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
2689                                 : mlir::arith::CmpIPredicate::slt;
2690   static constexpr mlir::arith::CmpFPredicate orderedCmp =
2691       extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
2692                                 : mlir::arith::CmpFPredicate::OLT;
2693   mlir::Type type = left.getType();
2694   mlir::Value result;
2695   if (fir::isa_real(type)) {
2696     // Note: the signaling/quit aspect of the result required by IEEE
2697     // cannot currently be obtained with LLVM without ad-hoc runtime.
2698     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
2699       // Return the number if one of the inputs is NaN and the other is
2700       // a number.
2701       auto leftIsResult =
2702           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
2703       auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
2704           loc, mlir::arith::CmpFPredicate::UNE, right, right);
2705       result =
2706           builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
2707     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
2708       // Always return NaNs if one the input is NaNs
2709       auto leftIsResult =
2710           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
2711       auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
2712           loc, mlir::arith::CmpFPredicate::UNE, left, left);
2713       result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
2714     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
2715       // If the left is a NaN, return the right whatever it is.
2716       result =
2717           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
2718     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
2719       // If one of the operand is a NaN, return left whatever it is.
2720       static constexpr auto unorderedCmp =
2721           extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
2722                                     : mlir::arith::CmpFPredicate::ULT;
2723       result =
2724           builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
2725     } else {
2726       // TODO: ieeeMinNum/ieeeMaxNum
2727       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
2728                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
2729     }
2730   } else if (fir::isa_integer(type)) {
2731     result =
2732         builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
2733   } else if (fir::isa_char(type)) {
2734     // TODO: ! character min and max is tricky because the result
2735     // length is the length of the longest argument!
2736     // So we may need a temp.
2737     TODO(loc, "CHARACTER min and max");
2738   }
2739   assert(result && "result must be defined");
2740   return result;
2741 }
2742 
2743 // MAXLOC
2744 fir::ExtendedValue
2745 IntrinsicLibrary::genMaxloc(mlir::Type resultType,
2746                             llvm::ArrayRef<fir::ExtendedValue> args) {
2747   return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
2748                         resultType, builder, loc, stmtCtx,
2749                         "unexpected result for Maxloc", args);
2750 }
2751 
2752 // MAXVAL
2753 fir::ExtendedValue
2754 IntrinsicLibrary::genMaxval(mlir::Type resultType,
2755                             llvm::ArrayRef<fir::ExtendedValue> args) {
2756   return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
2757                         fir::runtime::genMaxvalChar, resultType, builder, loc,
2758                         stmtCtx, "unexpected result for Maxval", args);
2759 }
2760 
2761 // MERGE
2762 fir::ExtendedValue
2763 IntrinsicLibrary::genMerge(mlir::Type,
2764                            llvm::ArrayRef<fir::ExtendedValue> args) {
2765   assert(args.size() == 3);
2766   mlir::Value arg0 = fir::getBase(args[0]);
2767   mlir::Value arg1 = fir::getBase(args[1]);
2768   mlir::Value arg2 = fir::getBase(args[2]);
2769   mlir::Type type0 = fir::unwrapRefType(arg0.getType());
2770   bool isCharRslt = fir::isa_char(type0); // result is same as first argument
2771   mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), arg2);
2772   auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, arg0, arg1);
2773   if (isCharRslt) {
2774     // Need a CharBoxValue for character results
2775     const fir::CharBoxValue *charBox = args[0].getCharBox();
2776     fir::CharBoxValue charRslt(rslt, charBox->getLen());
2777     return charRslt;
2778   }
2779   return rslt;
2780 }
2781 
2782 // MINLOC
2783 fir::ExtendedValue
2784 IntrinsicLibrary::genMinloc(mlir::Type resultType,
2785                             llvm::ArrayRef<fir::ExtendedValue> args) {
2786   return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
2787                         resultType, builder, loc, stmtCtx,
2788                         "unexpected result for Minloc", args);
2789 }
2790 
2791 // MINVAL
2792 fir::ExtendedValue
2793 IntrinsicLibrary::genMinval(mlir::Type resultType,
2794                             llvm::ArrayRef<fir::ExtendedValue> args) {
2795   return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
2796                         fir::runtime::genMinvalChar, resultType, builder, loc,
2797                         stmtCtx, "unexpected result for Minval", args);
2798 }
2799 
2800 // MIN and MAX
2801 template <Extremum extremum, ExtremumBehavior behavior>
2802 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
2803                                           llvm::ArrayRef<mlir::Value> args) {
2804   assert(args.size() >= 1);
2805   mlir::Value result = args[0];
2806   for (auto arg : args.drop_front()) {
2807     mlir::Value mask =
2808         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
2809     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
2810   }
2811   return result;
2812 }
2813 
2814 // MOD
2815 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
2816                                      llvm::ArrayRef<mlir::Value> args) {
2817   assert(args.size() == 2);
2818   if (resultType.isa<mlir::IntegerType>())
2819     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
2820 
2821   // Use runtime. Note that mlir::arith::RemFOp implements floating point
2822   // remainder, but it does not work with fir::Real type.
2823   // TODO: consider using mlir::arith::RemFOp when possible, that may help
2824   // folding and  optimizations.
2825   return genRuntimeCall("mod", resultType, args);
2826 }
2827 
2828 // MODULO
2829 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
2830                                         llvm::ArrayRef<mlir::Value> args) {
2831   assert(args.size() == 2);
2832   // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
2833   // In the meantime, use a simple inlined implementation based on truncated
2834   // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
2835   // division and multiplication from MODULO formula.
2836   //  - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
2837   //  - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
2838   //    A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
2839   // Note that A/P < 0 if and only if A and P signs are different.
2840   if (resultType.isa<mlir::IntegerType>()) {
2841     auto remainder =
2842         builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
2843     auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
2844     mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
2845     auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
2846         loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
2847     auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
2848         loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
2849     auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
2850                                                         argSignDifferent);
2851     auto remPlusP =
2852         builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
2853     return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
2854                                                  remainder);
2855   }
2856   // Real case
2857   auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
2858   mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
2859   auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
2860       loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
2861   auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
2862       loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
2863   auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
2864       loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
2865   auto argSignDifferent =
2866       builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
2867   auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
2868                                                       argSignDifferent);
2869   auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
2870   return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
2871                                                remainder);
2872 }
2873 
2874 // NEAREST
2875 mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
2876                                          llvm::ArrayRef<mlir::Value> args) {
2877   assert(args.size() == 2);
2878 
2879   mlir::Value realX = fir::getBase(args[0]);
2880   mlir::Value realS = fir::getBase(args[1]);
2881 
2882   return builder.createConvert(
2883       loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS));
2884 }
2885 
2886 // NINT
2887 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
2888                                       llvm::ArrayRef<mlir::Value> args) {
2889   assert(args.size() >= 1);
2890   // Skip optional kind argument to search the runtime; it is already reflected
2891   // in result type.
2892   return genRuntimeCall("nint", resultType, {args[0]});
2893 }
2894 
2895 // NOT
2896 mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
2897                                      llvm::ArrayRef<mlir::Value> args) {
2898   assert(args.size() == 1);
2899   mlir::Value allOnes = builder.createIntegerConstant(loc, resultType, -1);
2900   return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
2901 }
2902 
2903 // NULL
2904 fir::ExtendedValue
2905 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
2906   // NULL() without MOLD must be handled in the contexts where it can appear
2907   // (see table 16.5 of Fortran 2018 standard).
2908   assert(args.size() == 1 && isPresent(args[0]) &&
2909          "MOLD argument required to lower NULL outside of any context");
2910   const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
2911   assert(mold && "MOLD must be a pointer or allocatable");
2912   fir::BoxType boxType = mold->getBoxTy();
2913   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
2914   mlir::Value box = fir::factory::createUnallocatedBox(
2915       builder, loc, boxType, mold->nonDeferredLenParams());
2916   builder.create<fir::StoreOp>(loc, box, boxStorage);
2917   return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
2918 }
2919 
2920 // PACK
2921 fir::ExtendedValue
2922 IntrinsicLibrary::genPack(mlir::Type resultType,
2923                           llvm::ArrayRef<fir::ExtendedValue> args) {
2924   [[maybe_unused]] auto numArgs = args.size();
2925   assert(numArgs == 2 || numArgs == 3);
2926 
2927   // Handle required array argument
2928   mlir::Value array = builder.createBox(loc, args[0]);
2929 
2930   // Handle required mask argument
2931   mlir::Value mask = builder.createBox(loc, args[1]);
2932 
2933   // Handle optional vector argument
2934   mlir::Value vector = isAbsent(args, 2)
2935                            ? builder.create<fir::AbsentOp>(
2936                                  loc, fir::BoxType::get(builder.getI1Type()))
2937                            : builder.createBox(loc, args[2]);
2938 
2939   // Create mutable fir.box to be passed to the runtime for the result.
2940   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
2941   fir::MutableBoxValue resultMutableBox =
2942       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2943   mlir::Value resultIrBox =
2944       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2945 
2946   fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
2947 
2948   return readAndAddCleanUp(resultMutableBox, resultType,
2949                            "unexpected result for PACK");
2950 }
2951 
2952 // PRESENT
2953 fir::ExtendedValue
2954 IntrinsicLibrary::genPresent(mlir::Type,
2955                              llvm::ArrayRef<fir::ExtendedValue> args) {
2956   assert(args.size() == 1);
2957   return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
2958                                           fir::getBase(args[0]));
2959 }
2960 
2961 // PRODUCT
2962 fir::ExtendedValue
2963 IntrinsicLibrary::genProduct(mlir::Type resultType,
2964                              llvm::ArrayRef<fir::ExtendedValue> args) {
2965   return genProdOrSum(fir::runtime::genProduct, fir::runtime::genProductDim,
2966                       resultType, builder, loc, stmtCtx,
2967                       "unexpected result for Product", args);
2968 }
2969 
2970 // RANDOM_INIT
2971 void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
2972   assert(args.size() == 2);
2973   Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]),
2974                                 fir::getBase(args[1]));
2975 }
2976 
2977 // RANDOM_NUMBER
2978 void IntrinsicLibrary::genRandomNumber(
2979     llvm::ArrayRef<fir::ExtendedValue> args) {
2980   assert(args.size() == 1);
2981   Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
2982 }
2983 
2984 // RANDOM_SEED
2985 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
2986   assert(args.size() == 3);
2987   for (int i = 0; i < 3; ++i)
2988     if (isPresent(args[i])) {
2989       Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i]));
2990       return;
2991     }
2992   Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
2993 }
2994 
2995 // REPEAT
2996 fir::ExtendedValue
2997 IntrinsicLibrary::genRepeat(mlir::Type resultType,
2998                             llvm::ArrayRef<fir::ExtendedValue> args) {
2999   assert(args.size() == 2);
3000   mlir::Value string = builder.createBox(loc, args[0]);
3001   mlir::Value ncopies = fir::getBase(args[1]);
3002   // Create mutable fir.box to be passed to the runtime for the result.
3003   fir::MutableBoxValue resultMutableBox =
3004       fir::factory::createTempMutableBox(builder, loc, resultType);
3005   mlir::Value resultIrBox =
3006       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3007   // Call runtime. The runtime is allocating the result.
3008   fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
3009   // Read result from mutable fir.box and add it to the list of temps to be
3010   // finalized by the StatementContext.
3011   return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
3012 }
3013 
3014 // RESHAPE
3015 fir::ExtendedValue
3016 IntrinsicLibrary::genReshape(mlir::Type resultType,
3017                              llvm::ArrayRef<fir::ExtendedValue> args) {
3018   assert(args.size() == 4);
3019 
3020   // Handle source argument
3021   mlir::Value source = builder.createBox(loc, args[0]);
3022 
3023   // Handle shape argument
3024   mlir::Value shape = builder.createBox(loc, args[1]);
3025   assert(fir::BoxValue(shape).rank() == 1);
3026   mlir::Type shapeTy = shape.getType();
3027   mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
3028   auto resultRank = shapeArrTy.cast<fir::SequenceType>().getShape();
3029 
3030   assert(resultRank[0] != fir::SequenceType::getUnknownExtent() &&
3031          "shape arg must have constant size");
3032 
3033   // Handle optional pad argument
3034   mlir::Value pad = isAbsent(args[2])
3035                         ? builder.create<fir::AbsentOp>(
3036                               loc, fir::BoxType::get(builder.getI1Type()))
3037                         : builder.createBox(loc, args[2]);
3038 
3039   // Handle optional order argument
3040   mlir::Value order = isAbsent(args[3])
3041                           ? builder.create<fir::AbsentOp>(
3042                                 loc, fir::BoxType::get(builder.getI1Type()))
3043                           : builder.createBox(loc, args[3]);
3044 
3045   // Create mutable fir.box to be passed to the runtime for the result.
3046   mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank[0]);
3047   fir::MutableBoxValue resultMutableBox =
3048       fir::factory::createTempMutableBox(builder, loc, type);
3049 
3050   mlir::Value resultIrBox =
3051       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3052 
3053   fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
3054                            order);
3055 
3056   return readAndAddCleanUp(resultMutableBox, resultType,
3057                            "unexpected result for RESHAPE");
3058 }
3059 
3060 // RRSPACING
3061 mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
3062                                            llvm::ArrayRef<mlir::Value> args) {
3063   assert(args.size() == 1);
3064 
3065   return builder.createConvert(
3066       loc, resultType,
3067       fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
3068 }
3069 
3070 // SCALE
3071 mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
3072                                        llvm::ArrayRef<mlir::Value> args) {
3073   assert(args.size() == 2);
3074 
3075   mlir::Value realX = fir::getBase(args[0]);
3076   mlir::Value intI = fir::getBase(args[1]);
3077 
3078   return builder.createConvert(
3079       loc, resultType, fir::runtime::genScale(builder, loc, realX, intI));
3080 }
3081 
3082 // SCAN
3083 fir::ExtendedValue
3084 IntrinsicLibrary::genScan(mlir::Type resultType,
3085                           llvm::ArrayRef<fir::ExtendedValue> args) {
3086 
3087   assert(args.size() == 4);
3088 
3089   if (isAbsent(args[3])) {
3090     // Kind not specified, so call scan/verify runtime routine that is
3091     // specialized on the kind of characters in string.
3092 
3093     // Handle required string base arg
3094     mlir::Value stringBase = fir::getBase(args[0]);
3095 
3096     // Handle required set string base arg
3097     mlir::Value setBase = fir::getBase(args[1]);
3098 
3099     // Handle kind argument; it is the kind of character in this case
3100     fir::KindTy kind =
3101         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3102             stringBase.getType());
3103 
3104     // Get string length argument
3105     mlir::Value stringLen = fir::getLen(args[0]);
3106 
3107     // Get set string length argument
3108     mlir::Value setLen = fir::getLen(args[1]);
3109 
3110     // Handle optional back argument
3111     mlir::Value back =
3112         isAbsent(args[2])
3113             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3114             : fir::getBase(args[2]);
3115 
3116     return builder.createConvert(loc, resultType,
3117                                  fir::runtime::genScan(builder, loc, kind,
3118                                                        stringBase, stringLen,
3119                                                        setBase, setLen, back));
3120   }
3121   // else use the runtime descriptor version of scan/verify
3122 
3123   // Handle optional argument, back
3124   auto makeRefThenEmbox = [&](mlir::Value b) {
3125     fir::LogicalType logTy = fir::LogicalType::get(
3126         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3127     mlir::Value temp = builder.createTemporary(loc, logTy);
3128     mlir::Value castb = builder.createConvert(loc, logTy, b);
3129     builder.create<fir::StoreOp>(loc, castb, temp);
3130     return builder.createBox(loc, temp);
3131   };
3132   mlir::Value back = fir::isUnboxedValue(args[2])
3133                          ? makeRefThenEmbox(*args[2].getUnboxed())
3134                          : builder.create<fir::AbsentOp>(
3135                                loc, fir::BoxType::get(builder.getI1Type()));
3136 
3137   // Handle required string argument
3138   mlir::Value string = builder.createBox(loc, args[0]);
3139 
3140   // Handle required set argument
3141   mlir::Value set = builder.createBox(loc, args[1]);
3142 
3143   // Handle kind argument
3144   mlir::Value kind = fir::getBase(args[3]);
3145 
3146   // Create result descriptor
3147   fir::MutableBoxValue resultMutableBox =
3148       fir::factory::createTempMutableBox(builder, loc, resultType);
3149   mlir::Value resultIrBox =
3150       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3151 
3152   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
3153                                   kind);
3154 
3155   // Handle cleanup of allocatable result descriptor and return
3156   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
3157 }
3158 
3159 // SET_EXPONENT
3160 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
3161                                              llvm::ArrayRef<mlir::Value> args) {
3162   assert(args.size() == 2);
3163 
3164   return builder.createConvert(
3165       loc, resultType,
3166       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
3167                                    fir::getBase(args[1])));
3168 }
3169 
3170 // SIGN
3171 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
3172                                       llvm::ArrayRef<mlir::Value> args) {
3173   assert(args.size() == 2);
3174   if (resultType.isa<mlir::IntegerType>()) {
3175     mlir::Value abs = genAbs(resultType, {args[0]});
3176     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3177     auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
3178     auto cmp = builder.create<mlir::arith::CmpIOp>(
3179         loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
3180     return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
3181   }
3182   return genRuntimeCall("sign", resultType, args);
3183 }
3184 
3185 // SPACING
3186 mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
3187                                          llvm::ArrayRef<mlir::Value> args) {
3188   assert(args.size() == 1);
3189 
3190   return builder.createConvert(
3191       loc, resultType,
3192       fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
3193 }
3194 
3195 // SIZE
3196 fir::ExtendedValue
3197 IntrinsicLibrary::genSize(mlir::Type resultType,
3198                           llvm::ArrayRef<fir::ExtendedValue> args) {
3199   // Note that the value of the KIND argument is already reflected in the
3200   // resultType
3201   assert(args.size() == 3);
3202   if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
3203     if (boxValue->hasAssumedRank())
3204       TODO(loc, "SIZE intrinsic with assumed rank argument");
3205 
3206   // Get the ARRAY argument
3207   mlir::Value array = builder.createBox(loc, args[0]);
3208 
3209   // The front-end rewrites SIZE without the DIM argument to
3210   // an array of SIZE with DIM in most cases, but it may not be
3211   // possible in some cases like when in SIZE(function_call()).
3212   if (isAbsent(args, 1))
3213     return builder.createConvert(loc, resultType,
3214                                  fir::runtime::genSize(builder, loc, array));
3215 
3216   // Get the DIM argument.
3217   mlir::Value dim = fir::getBase(args[1]);
3218   if (!fir::isa_ref_type(dim.getType()))
3219     return builder.createConvert(
3220         loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
3221 
3222   mlir::Value isDynamicallyAbsent = builder.genIsNull(loc, dim);
3223   return builder
3224       .genIfOp(loc, {resultType}, isDynamicallyAbsent,
3225                /*withElseRegion=*/true)
3226       .genThen([&]() {
3227         mlir::Value size = builder.createConvert(
3228             loc, resultType, fir::runtime::genSize(builder, loc, array));
3229         builder.create<fir::ResultOp>(loc, size);
3230       })
3231       .genElse([&]() {
3232         mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
3233         mlir::Value size = builder.createConvert(
3234             loc, resultType,
3235             fir::runtime::genSizeDim(builder, loc, array, dimValue));
3236         builder.create<fir::ResultOp>(loc, size);
3237       })
3238       .getResults()[0];
3239 }
3240 
3241 // SPREAD
3242 fir::ExtendedValue
3243 IntrinsicLibrary::genSpread(mlir::Type resultType,
3244                             llvm::ArrayRef<fir::ExtendedValue> args) {
3245 
3246   assert(args.size() == 3);
3247 
3248   // Handle source argument
3249   mlir::Value source = builder.createBox(loc, args[0]);
3250   fir::BoxValue sourceTmp = source;
3251   unsigned sourceRank = sourceTmp.rank();
3252 
3253   // Handle Dim argument
3254   mlir::Value dim = fir::getBase(args[1]);
3255 
3256   // Handle ncopies argument
3257   mlir::Value ncopies = fir::getBase(args[2]);
3258 
3259   // Generate result descriptor
3260   mlir::Type resultArrayType =
3261       builder.getVarLenSeqTy(resultType, sourceRank + 1);
3262   fir::MutableBoxValue resultMutableBox =
3263       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3264   mlir::Value resultIrBox =
3265       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3266 
3267   fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
3268 
3269   return readAndAddCleanUp(resultMutableBox, resultType,
3270                            "unexpected result for SPREAD");
3271 }
3272 
3273 // SUM
3274 fir::ExtendedValue
3275 IntrinsicLibrary::genSum(mlir::Type resultType,
3276                          llvm::ArrayRef<fir::ExtendedValue> args) {
3277   return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
3278                       builder, loc, stmtCtx, "unexpected result for Sum", args);
3279 }
3280 
3281 // SYSTEM_CLOCK
3282 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
3283   assert(args.size() == 3);
3284   Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
3285                                  fir::getBase(args[1]), fir::getBase(args[2]));
3286 }
3287 
3288 // TRANSFER
3289 fir::ExtendedValue
3290 IntrinsicLibrary::genTransfer(mlir::Type resultType,
3291                               llvm::ArrayRef<fir::ExtendedValue> args) {
3292 
3293   assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
3294 
3295   // Handle source argument
3296   mlir::Value source = builder.createBox(loc, args[0]);
3297 
3298   // Handle mold argument
3299   mlir::Value mold = builder.createBox(loc, args[1]);
3300   fir::BoxValue moldTmp = mold;
3301   unsigned moldRank = moldTmp.rank();
3302 
3303   bool absentSize = (args.size() == 2);
3304 
3305   // Create mutable fir.box to be passed to the runtime for the result.
3306   mlir::Type type = (moldRank == 0 && absentSize)
3307                         ? resultType
3308                         : builder.getVarLenSeqTy(resultType, 1);
3309   fir::MutableBoxValue resultMutableBox =
3310       fir::factory::createTempMutableBox(builder, loc, type);
3311 
3312   if (moldRank == 0 && absentSize) {
3313     // This result is a scalar in this case.
3314     mlir::Value resultIrBox =
3315         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3316 
3317     Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
3318   } else {
3319     // The result is a rank one array in this case.
3320     mlir::Value resultIrBox =
3321         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3322 
3323     if (absentSize) {
3324       Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
3325     } else {
3326       mlir::Value sizeArg = fir::getBase(args[2]);
3327       Fortran::lower::genTransferSize(builder, loc, resultIrBox, source, mold,
3328                                       sizeArg);
3329     }
3330   }
3331   return readAndAddCleanUp(resultMutableBox, resultType,
3332                            "unexpected result for TRANSFER");
3333 }
3334 
3335 // LBOUND
3336 fir::ExtendedValue
3337 IntrinsicLibrary::genLbound(mlir::Type resultType,
3338                             llvm::ArrayRef<fir::ExtendedValue> args) {
3339   // Calls to LBOUND that don't have the DIM argument, or for which
3340   // the DIM is a compile time constant, are folded to descriptor inquiries by
3341   // semantics.  This function covers the situations where a call to the
3342   // runtime is required.
3343   assert(args.size() == 3);
3344   assert(!isAbsent(args[1]));
3345   if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
3346     if (boxValue->hasAssumedRank())
3347       TODO(loc, "LBOUND intrinsic with assumed rank argument");
3348 
3349   const fir::ExtendedValue &array = args[0];
3350   mlir::Value box = array.match(
3351       [&](const fir::BoxValue &boxValue) -> mlir::Value {
3352         // This entity is mapped to a fir.box that may not contain the local
3353         // lower bound information if it is a dummy. Rebox it with the local
3354         // shape information.
3355         mlir::Value localShape = builder.createShape(loc, array);
3356         mlir::Value oldBox = boxValue.getAddr();
3357         return builder.create<fir::ReboxOp>(
3358             loc, oldBox.getType(), oldBox, localShape, /*slice=*/mlir::Value{});
3359       },
3360       [&](const auto &) -> mlir::Value {
3361         // This a pointer/allocatable, or an entity not yet tracked with a
3362         // fir.box. For pointer/allocatable, createBox will forward the
3363         // descriptor that contains the correct lower bound information. For
3364         // other entities, a new fir.box will be made with the local lower
3365         // bounds.
3366         return builder.createBox(loc, array);
3367       });
3368 
3369   mlir::Value dim = fir::getBase(args[1]);
3370   return builder.createConvert(
3371       loc, resultType,
3372       fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
3373 }
3374 
3375 // UBOUND
3376 fir::ExtendedValue
3377 IntrinsicLibrary::genUbound(mlir::Type resultType,
3378                             llvm::ArrayRef<fir::ExtendedValue> args) {
3379   assert(args.size() == 3 || args.size() == 2);
3380   if (args.size() == 3) {
3381     // Handle calls to UBOUND with the DIM argument, which return a scalar
3382     mlir::Value extent = fir::getBase(genSize(resultType, args));
3383     mlir::Value lbound = fir::getBase(genLbound(resultType, args));
3384 
3385     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3386     mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
3387     return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
3388   } else {
3389     // Handle calls to UBOUND without the DIM argument, which return an array
3390     mlir::Value kind = isAbsent(args[1])
3391                            ? builder.createIntegerConstant(
3392                                  loc, builder.getIndexType(),
3393                                  builder.getKindMap().defaultIntegerKind())
3394                            : fir::getBase(args[1]);
3395 
3396     // Create mutable fir.box to be passed to the runtime for the result.
3397     mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
3398     fir::MutableBoxValue resultMutableBox =
3399         fir::factory::createTempMutableBox(builder, loc, type);
3400     mlir::Value resultIrBox =
3401         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3402 
3403     fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(args[0]),
3404                             kind);
3405 
3406     return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
3407   }
3408   return mlir::Value();
3409 }
3410 
3411 // TRANSPOSE
3412 fir::ExtendedValue
3413 IntrinsicLibrary::genTranspose(mlir::Type resultType,
3414                                llvm::ArrayRef<fir::ExtendedValue> args) {
3415 
3416   assert(args.size() == 1);
3417 
3418   // Handle source argument
3419   mlir::Value source = builder.createBox(loc, args[0]);
3420 
3421   // Create mutable fir.box to be passed to the runtime for the result.
3422   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
3423   fir::MutableBoxValue resultMutableBox =
3424       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3425   mlir::Value resultIrBox =
3426       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3427   // Call runtime. The runtime is allocating the result.
3428   fir::runtime::genTranspose(builder, loc, resultIrBox, source);
3429   // Read result from mutable fir.box and add it to the list of temps to be
3430   // finalized by the StatementContext.
3431   return readAndAddCleanUp(resultMutableBox, resultType,
3432                            "unexpected result for TRANSPOSE");
3433 }
3434 
3435 // TRIM
3436 fir::ExtendedValue
3437 IntrinsicLibrary::genTrim(mlir::Type resultType,
3438                           llvm::ArrayRef<fir::ExtendedValue> args) {
3439   assert(args.size() == 1);
3440   mlir::Value string = builder.createBox(loc, args[0]);
3441   // Create mutable fir.box to be passed to the runtime for the result.
3442   fir::MutableBoxValue resultMutableBox =
3443       fir::factory::createTempMutableBox(builder, loc, resultType);
3444   mlir::Value resultIrBox =
3445       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3446   // Call runtime. The runtime is allocating the result.
3447   fir::runtime::genTrim(builder, loc, resultIrBox, string);
3448   // Read result from mutable fir.box and add it to the list of temps to be
3449   // finalized by the StatementContext.
3450   return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
3451 }
3452 
3453 // UNPACK
3454 fir::ExtendedValue
3455 IntrinsicLibrary::genUnpack(mlir::Type resultType,
3456                             llvm::ArrayRef<fir::ExtendedValue> args) {
3457   assert(args.size() == 3);
3458 
3459   // Handle required vector argument
3460   mlir::Value vector = builder.createBox(loc, args[0]);
3461 
3462   // Handle required mask argument
3463   fir::BoxValue maskBox = builder.createBox(loc, args[1]);
3464   mlir::Value mask = fir::getBase(maskBox);
3465   unsigned maskRank = maskBox.rank();
3466 
3467   // Handle required field argument
3468   mlir::Value field = builder.createBox(loc, args[2]);
3469 
3470   // Create mutable fir.box to be passed to the runtime for the result.
3471   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
3472   fir::MutableBoxValue resultMutableBox =
3473       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3474   mlir::Value resultIrBox =
3475       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3476 
3477   fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
3478 
3479   return readAndAddCleanUp(resultMutableBox, resultType,
3480                            "unexpected result for UNPACK");
3481 }
3482 
3483 // VERIFY
3484 fir::ExtendedValue
3485 IntrinsicLibrary::genVerify(mlir::Type resultType,
3486                             llvm::ArrayRef<fir::ExtendedValue> args) {
3487 
3488   assert(args.size() == 4);
3489 
3490   if (isAbsent(args[3])) {
3491     // Kind not specified, so call scan/verify runtime routine that is
3492     // specialized on the kind of characters in string.
3493 
3494     // Handle required string base arg
3495     mlir::Value stringBase = fir::getBase(args[0]);
3496 
3497     // Handle required set string base arg
3498     mlir::Value setBase = fir::getBase(args[1]);
3499 
3500     // Handle kind argument; it is the kind of character in this case
3501     fir::KindTy kind =
3502         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3503             stringBase.getType());
3504 
3505     // Get string length argument
3506     mlir::Value stringLen = fir::getLen(args[0]);
3507 
3508     // Get set string length argument
3509     mlir::Value setLen = fir::getLen(args[1]);
3510 
3511     // Handle optional back argument
3512     mlir::Value back =
3513         isAbsent(args[2])
3514             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3515             : fir::getBase(args[2]);
3516 
3517     return builder.createConvert(
3518         loc, resultType,
3519         fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
3520                                 setBase, setLen, back));
3521   }
3522   // else use the runtime descriptor version of scan/verify
3523 
3524   // Handle optional argument, back
3525   auto makeRefThenEmbox = [&](mlir::Value b) {
3526     fir::LogicalType logTy = fir::LogicalType::get(
3527         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3528     mlir::Value temp = builder.createTemporary(loc, logTy);
3529     mlir::Value castb = builder.createConvert(loc, logTy, b);
3530     builder.create<fir::StoreOp>(loc, castb, temp);
3531     return builder.createBox(loc, temp);
3532   };
3533   mlir::Value back = fir::isUnboxedValue(args[2])
3534                          ? makeRefThenEmbox(*args[2].getUnboxed())
3535                          : builder.create<fir::AbsentOp>(
3536                                loc, fir::BoxType::get(builder.getI1Type()));
3537 
3538   // Handle required string argument
3539   mlir::Value string = builder.createBox(loc, args[0]);
3540 
3541   // Handle required set argument
3542   mlir::Value set = builder.createBox(loc, args[1]);
3543 
3544   // Handle kind argument
3545   mlir::Value kind = fir::getBase(args[3]);
3546 
3547   // Create result descriptor
3548   fir::MutableBoxValue resultMutableBox =
3549       fir::factory::createTempMutableBox(builder, loc, resultType);
3550   mlir::Value resultIrBox =
3551       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3552 
3553   fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
3554                                     back, kind);
3555 
3556   // Handle cleanup of allocatable result descriptor and return
3557   return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
3558 }
3559 
3560 //===----------------------------------------------------------------------===//
3561 // Argument lowering rules interface
3562 //===----------------------------------------------------------------------===//
3563 
3564 const Fortran::lower::IntrinsicArgumentLoweringRules *
3565 Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
3566   if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName))
3567     if (!handler->argLoweringRules.hasDefaultRules())
3568       return &handler->argLoweringRules;
3569   return nullptr;
3570 }
3571 
3572 /// Return how argument \p argName should be lowered given the rules for the
3573 /// intrinsic function.
3574 Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
3575     mlir::Location loc, const IntrinsicArgumentLoweringRules &rules,
3576     llvm::StringRef argName) {
3577   for (const IntrinsicDummyArgument &arg : rules.args) {
3578     if (arg.name && arg.name == argName)
3579       return {arg.lowerAs, arg.handleDynamicOptional};
3580   }
3581   fir::emitFatalError(
3582       loc, "internal: unknown intrinsic argument name in lowering '" + argName +
3583                "'");
3584 }
3585 
3586 //===----------------------------------------------------------------------===//
3587 // Public intrinsic call helpers
3588 //===----------------------------------------------------------------------===//
3589 
3590 fir::ExtendedValue
3591 Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
3592                                  llvm::StringRef name,
3593                                  llvm::Optional<mlir::Type> resultType,
3594                                  llvm::ArrayRef<fir::ExtendedValue> args,
3595                                  Fortran::lower::StatementContext &stmtCtx) {
3596   return IntrinsicLibrary{builder, loc, &stmtCtx}.genIntrinsicCall(
3597       name, resultType, args);
3598 }
3599 
3600 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
3601                                    mlir::Location loc,
3602                                    llvm::ArrayRef<mlir::Value> args) {
3603   assert(args.size() > 0 && "max requires at least one argument");
3604   return IntrinsicLibrary{builder, loc}
3605       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
3606                                                               args);
3607 }
3608 
3609 mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
3610                                    mlir::Location loc, mlir::Type type,
3611                                    mlir::Value x, mlir::Value y) {
3612   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
3613 }
3614