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/Optimizer/Builder/Character.h"
23 #include "flang/Optimizer/Builder/Complex.h"
24 #include "flang/Optimizer/Builder/FIRBuilder.h"
25 #include "flang/Optimizer/Builder/MutableBox.h"
26 #include "flang/Optimizer/Builder/Runtime/Character.h"
27 #include "flang/Optimizer/Builder/Runtime/Command.h"
28 #include "flang/Optimizer/Builder/Runtime/Inquiry.h"
29 #include "flang/Optimizer/Builder/Runtime/Numeric.h"
30 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
31 #include "flang/Optimizer/Builder/Runtime/Reduction.h"
32 #include "flang/Optimizer/Builder/Runtime/Stop.h"
33 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
34 #include "flang/Optimizer/Builder/Todo.h"
35 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
36 #include "flang/Optimizer/Support/FatalError.h"
37 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
38 #include "mlir/Dialect/Math/IR/Math.h"
39 #include "llvm/Support/CommandLine.h"
40 #include "llvm/Support/Debug.h"
41 
42 #define DEBUG_TYPE "flang-lower-intrinsic"
43 
44 #define PGMATH_DECLARE
45 #include "flang/Evaluate/pgmath.h.inc"
46 
47 /// This file implements lowering of Fortran intrinsic procedures and Fortran
48 /// intrinsic module procedures.  A call may be inlined with a mix of FIR and
49 /// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
50 
51 /// Lowering of intrinsic procedure calls is based on a map that associates
52 /// Fortran intrinsic generic names to FIR generator functions.
53 /// All generator functions are member functions of the IntrinsicLibrary class
54 /// and have the same interface.
55 /// If no generator is given for an intrinsic name, a math runtime library
56 /// is searched for an implementation and, if a runtime function is found,
57 /// a call is generated for it. LLVM intrinsics are handled as a math
58 /// runtime library here.
59 
60 /// Enums used to templatize and share lowering of MIN and MAX.
61 enum class Extremum { Min, Max };
62 
63 // There are different ways to deal with NaNs in MIN and MAX.
64 // Known existing behaviors are listed below and can be selected for
65 // f18 MIN/MAX implementation.
66 enum class ExtremumBehavior {
67   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
68   // not described because there is no way to control/observe such aspect in
69   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
70   // aspect that are therefore currently not enforced. In the descriptions
71   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
72   // if one of the input NaN was signaling but it cannot be guaranteed either.
73   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
74   // signaling/quiet requirements.
75   IeeeMinMaximumNumber,
76   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
77   // If one of the argument is and number and the other is NaN, return the
78   // number. If both arguements are NaN, return NaN.
79   // Compilers: gfortran.
80   IeeeMinMaximum,
81   // IEEE minimum/maximum behavior (754-2019, section 9.6):
82   // If one of the argument is NaN, return NaN.
83   MinMaxss,
84   // x86 minss/maxss behavior:
85   // If the second argument is a number and the other is NaN, return the number.
86   // In all other cases where at least one operand is NaN, return NaN.
87   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
88   PgfortranLlvm,
89   // "Opposite of" x86 minss/maxss behavior:
90   // If the first argument is a number and the other is NaN, return the
91   // number.
92   // In all other cases where at least one operand is NaN, return NaN.
93   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
94   IeeeMinMaxNum
95   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
96   // TODO: Not implemented.
97   // It is the only behavior where the signaling/quiet aspect of a NaN argument
98   // impacts if the result should be NaN or the argument that is a number.
99   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
100   // possible to implement it without some target dependent runtime.
101 };
102 
103 fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() {
104   return fir::UnboxedValue{};
105 }
106 
107 /// Test if an ExtendedValue is absent. This is used to test if an intrinsic
108 /// argument are absent at compile time.
109 static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {
110   return !fir::getBase(exv);
111 }
112 static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,
113                                size_t argIndex) {
114   return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);
115 }
116 static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
117                                size_t argIndex) {
118   return args.size() <= argIndex || !args[argIndex];
119 }
120 
121 /// Test if an ExtendedValue is present. This is used to test if an intrinsic
122 /// argument is present at compile time. This does not imply that the related
123 /// value may not be an absent dummy optional, disassociated pointer, or a
124 /// deallocated allocatable. See `handleDynamicOptional` to deal with these
125 /// cases when it makes sense.
126 static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
127   return !isStaticallyAbsent(exv);
128 }
129 
130 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
131 /// take a DIM argument.
132 template <typename FD>
133 static fir::ExtendedValue
134 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
135            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
136            llvm::StringRef errMsg, mlir::Value array, fir::ExtendedValue dimArg,
137            mlir::Value mask, int rank) {
138 
139   // Create mutable fir.box to be passed to the runtime for the result.
140   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
141   fir::MutableBoxValue resultMutableBox =
142       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
143   mlir::Value resultIrBox =
144       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
145 
146   mlir::Value dim =
147       isStaticallyAbsent(dimArg)
148           ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
149           : fir::getBase(dimArg);
150   funcDim(builder, loc, resultIrBox, array, dim, mask);
151 
152   fir::ExtendedValue res =
153       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
154   return res.match(
155       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
156         // Add cleanup code
157         assert(stmtCtx);
158         fir::FirOpBuilder *bldr = &builder;
159         mlir::Value temp = box.getAddr();
160         stmtCtx->attachCleanup(
161             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
162         return box;
163       },
164       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
165         // Add cleanup code
166         assert(stmtCtx);
167         fir::FirOpBuilder *bldr = &builder;
168         mlir::Value temp = box.getAddr();
169         stmtCtx->attachCleanup(
170             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
171         return box;
172       },
173       [&](const auto &) -> fir::ExtendedValue {
174         fir::emitFatalError(loc, errMsg);
175       });
176 }
177 
178 /// Process calls to Product, Sum intrinsic functions
179 template <typename FN, typename FD>
180 static fir::ExtendedValue
181 genProdOrSum(FN func, FD funcDim, mlir::Type resultType,
182              fir::FirOpBuilder &builder, mlir::Location loc,
183              Fortran::lower::StatementContext *stmtCtx, llvm::StringRef errMsg,
184              llvm::ArrayRef<fir::ExtendedValue> args) {
185 
186   assert(args.size() == 3);
187 
188   // Handle required array argument
189   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
190   mlir::Value array = fir::getBase(arryTmp);
191   int rank = arryTmp.rank();
192   assert(rank >= 1);
193 
194   // Handle optional mask argument
195   auto mask = isStaticallyAbsent(args[2])
196                   ? builder.create<fir::AbsentOp>(
197                         loc, fir::BoxType::get(builder.getI1Type()))
198                   : builder.createBox(loc, args[2]);
199 
200   bool absentDim = isStaticallyAbsent(args[1]);
201 
202   // We call the type specific versions because the result is scalar
203   // in the case below.
204   if (absentDim || rank == 1) {
205     mlir::Type ty = array.getType();
206     mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
207     auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
208     if (fir::isa_complex(eleTy)) {
209       mlir::Value result = builder.createTemporary(loc, eleTy);
210       func(builder, loc, array, mask, result);
211       return builder.create<fir::LoadOp>(loc, result);
212     }
213     auto resultBox = builder.create<fir::AbsentOp>(
214         loc, fir::BoxType::get(builder.getI1Type()));
215     return func(builder, loc, array, mask, resultBox);
216   }
217   // Handle Product/Sum cases that have an array result.
218   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
219                     args[1], mask, rank);
220 }
221 
222 /// Process calls to DotProduct
223 template <typename FN>
224 static fir::ExtendedValue
225 genDotProd(FN func, mlir::Type resultType, fir::FirOpBuilder &builder,
226            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
227            llvm::ArrayRef<fir::ExtendedValue> args) {
228 
229   assert(args.size() == 2);
230 
231   // Handle required vector arguments
232   mlir::Value vectorA = fir::getBase(args[0]);
233   mlir::Value vectorB = fir::getBase(args[1]);
234 
235   mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy(vectorA.getType())
236                          .cast<fir::SequenceType>()
237                          .getEleTy();
238   if (fir::isa_complex(eleTy)) {
239     mlir::Value result = builder.createTemporary(loc, eleTy);
240     func(builder, loc, vectorA, vectorB, result);
241     return builder.create<fir::LoadOp>(loc, result);
242   }
243 
244   auto resultBox = builder.create<fir::AbsentOp>(
245       loc, fir::BoxType::get(builder.getI1Type()));
246   return func(builder, loc, vectorA, vectorB, resultBox);
247 }
248 
249 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions
250 template <typename FN, typename FD, typename FC>
251 static fir::ExtendedValue
252 genExtremumVal(FN func, FD funcDim, FC funcChar, mlir::Type resultType,
253                fir::FirOpBuilder &builder, mlir::Location loc,
254                Fortran::lower::StatementContext *stmtCtx,
255                llvm::StringRef errMsg,
256                llvm::ArrayRef<fir::ExtendedValue> args) {
257 
258   assert(args.size() == 3);
259 
260   // Handle required array argument
261   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
262   mlir::Value array = fir::getBase(arryTmp);
263   int rank = arryTmp.rank();
264   assert(rank >= 1);
265   bool hasCharacterResult = arryTmp.isCharacter();
266 
267   // Handle optional mask argument
268   auto mask = isStaticallyAbsent(args[2])
269                   ? builder.create<fir::AbsentOp>(
270                         loc, fir::BoxType::get(builder.getI1Type()))
271                   : builder.createBox(loc, args[2]);
272 
273   bool absentDim = isStaticallyAbsent(args[1]);
274 
275   // For Maxval/MinVal, we call the type specific versions of
276   // Maxval/Minval because the result is scalar in the case below.
277   if (!hasCharacterResult && (absentDim || rank == 1))
278     return func(builder, loc, array, mask);
279 
280   if (hasCharacterResult && (absentDim || rank == 1)) {
281     // Create mutable fir.box to be passed to the runtime for the result.
282     fir::MutableBoxValue resultMutableBox =
283         fir::factory::createTempMutableBox(builder, loc, resultType);
284     mlir::Value resultIrBox =
285         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
286 
287     funcChar(builder, loc, resultIrBox, array, mask);
288 
289     // Handle cleanup of allocatable result descriptor and return
290     fir::ExtendedValue res =
291         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
292     return res.match(
293         [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
294           // Add cleanup code
295           assert(stmtCtx);
296           fir::FirOpBuilder *bldr = &builder;
297           mlir::Value temp = box.getAddr();
298           stmtCtx->attachCleanup(
299               [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
300           return box;
301         },
302         [&](const auto &) -> fir::ExtendedValue {
303           fir::emitFatalError(loc, errMsg);
304         });
305   }
306 
307   // Handle Min/Maxval cases that have an array result.
308   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
309                     args[1], mask, rank);
310 }
311 
312 /// Process calls to Minloc, Maxloc intrinsic functions
313 template <typename FN, typename FD>
314 static fir::ExtendedValue genExtremumloc(
315     FN func, FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
316     mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
317     llvm::StringRef errMsg, llvm::ArrayRef<fir::ExtendedValue> args) {
318 
319   assert(args.size() == 5);
320 
321   // Handle required array argument
322   mlir::Value array = builder.createBox(loc, args[0]);
323   unsigned rank = fir::BoxValue(array).rank();
324   assert(rank >= 1);
325 
326   // Handle optional mask argument
327   auto mask = isStaticallyAbsent(args[2])
328                   ? builder.create<fir::AbsentOp>(
329                         loc, fir::BoxType::get(builder.getI1Type()))
330                   : builder.createBox(loc, args[2]);
331 
332   // Handle optional kind argument
333   auto kind = isStaticallyAbsent(args[3])
334                   ? builder.createIntegerConstant(
335                         loc, builder.getIndexType(),
336                         builder.getKindMap().defaultIntegerKind())
337                   : fir::getBase(args[3]);
338 
339   // Handle optional back argument
340   auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)
341                                           : fir::getBase(args[4]);
342 
343   bool absentDim = isStaticallyAbsent(args[1]);
344 
345   if (!absentDim && rank == 1) {
346     // If dim argument is present and the array is rank 1, then the result is
347     // a scalar (since the the result is rank-1 or 0).
348     // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
349     mlir::Value dim = fir::getBase(args[1]);
350     // Create mutable fir.box to be passed to the runtime for the result.
351     fir::MutableBoxValue resultMutableBox =
352         fir::factory::createTempMutableBox(builder, loc, resultType);
353     mlir::Value resultIrBox =
354         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
355 
356     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
357 
358     // Handle cleanup of allocatable result descriptor and return
359     fir::ExtendedValue res =
360         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
361     return res.match(
362         [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
363           // Add cleanup code
364           assert(stmtCtx);
365           fir::FirOpBuilder *bldr = &builder;
366           stmtCtx->attachCleanup(
367               [=]() { bldr->create<fir::FreeMemOp>(loc, tempAddr); });
368           return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
369         },
370         [&](const auto &) -> fir::ExtendedValue {
371           fir::emitFatalError(loc, errMsg);
372         });
373   }
374 
375   // Note: The Min/Maxloc/val cases below have an array result.
376 
377   // Create mutable fir.box to be passed to the runtime for the result.
378   mlir::Type resultArrayType =
379       builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
380   fir::MutableBoxValue resultMutableBox =
381       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
382   mlir::Value resultIrBox =
383       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
384 
385   if (absentDim) {
386     // Handle min/maxloc/val case where there is no dim argument
387     // (calls Min/Maxloc()/MinMaxval() runtime routine)
388     func(builder, loc, resultIrBox, array, mask, kind, back);
389   } else {
390     // else handle min/maxloc case with dim argument (calls
391     // Min/Max/loc/val/Dim() runtime routine).
392     mlir::Value dim = fir::getBase(args[1]);
393     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
394   }
395 
396   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
397       .match(
398           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
399             // Add cleanup code
400             assert(stmtCtx);
401             fir::FirOpBuilder *bldr = &builder;
402             mlir::Value temp = box.getAddr();
403             stmtCtx->attachCleanup(
404                 [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
405             return box;
406           },
407           [&](const auto &) -> fir::ExtendedValue {
408             fir::emitFatalError(loc, errMsg);
409           });
410 }
411 
412 // TODO error handling -> return a code or directly emit messages ?
413 struct IntrinsicLibrary {
414 
415   // Constructors.
416   explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc,
417                             Fortran::lower::StatementContext *stmtCtx = nullptr)
418       : builder{builder}, loc{loc}, stmtCtx{stmtCtx} {}
419   IntrinsicLibrary() = delete;
420   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
421 
422   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
423   /// and expected result type \p resultType.
424   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
425                                       llvm::Optional<mlir::Type> resultType,
426                                       llvm::ArrayRef<fir::ExtendedValue> arg);
427 
428   /// Search a runtime function that is associated to the generic intrinsic name
429   /// and whose signature matches the intrinsic arguments and result types.
430   /// If no such runtime function is found but a runtime function associated
431   /// with the Fortran generic exists and has the same number of arguments,
432   /// conversions will be inserted before and/or after the call. This is to
433   /// mainly to allow 16 bits float support even-though little or no math
434   /// runtime is currently available for it.
435   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
436                              llvm::ArrayRef<mlir::Value>);
437 
438   using RuntimeCallGenerator = std::function<mlir::Value(
439       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
440   RuntimeCallGenerator
441   getRuntimeCallGenerator(llvm::StringRef name,
442                           mlir::FunctionType soughtFuncType);
443 
444   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
445   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
446   /// if the argument is an integer, into llvm intrinsics if the argument is
447   /// real and to the `hypot` math routine if the argument is of complex type.
448   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
449   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
450                                 mlir::Value, mlir::Value)>
451   fir::ExtendedValue genAdjustRtCall(mlir::Type,
452                                      llvm::ArrayRef<fir::ExtendedValue>);
453   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
454   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
455   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
456   fir::ExtendedValue genAllocated(mlir::Type,
457                                   llvm::ArrayRef<fir::ExtendedValue>);
458   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
459   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
460   fir::ExtendedValue
461       genCommandArgumentCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
462   fir::ExtendedValue genAssociated(mlir::Type,
463                                    llvm::ArrayRef<fir::ExtendedValue>);
464 
465   /// Lower a bitwise comparison intrinsic using the given comparator.
466   template <mlir::arith::CmpIPredicate pred>
467   mlir::Value genBitwiseCompare(mlir::Type resultType,
468                                 llvm::ArrayRef<mlir::Value> args);
469 
470   mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
471   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
472   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
473   template <mlir::arith::CmpIPredicate pred>
474   fir::ExtendedValue genCharacterCompare(mlir::Type,
475                                          llvm::ArrayRef<fir::ExtendedValue>);
476   mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
477   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
478   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
479   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
480   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
481   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
482   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
483   fir::ExtendedValue genDotProduct(mlir::Type,
484                                    llvm::ArrayRef<fir::ExtendedValue>);
485   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
486   mlir::Value genDshiftl(mlir::Type, llvm::ArrayRef<mlir::Value>);
487   mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
488   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
489   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
490   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
491   template <Extremum, ExtremumBehavior>
492   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
493   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
494   mlir::Value genFraction(mlir::Type resultType,
495                           mlir::ArrayRef<mlir::Value> args);
496   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
497   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
498   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
499   /// in the llvm::ArrayRef.
500   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
501   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
502   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
503   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
504   fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
505   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
506   template <mlir::arith::CmpIPredicate pred>
507   fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
508                                         llvm::ArrayRef<fir::ExtendedValue>);
509   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
510   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
511   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
512   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
513   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
514   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
515   mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
516   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
517   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
518   template <typename Shift>
519   mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>);
520   fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
521   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
522   fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
523   fir::ExtendedValue genMerge(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
524   mlir::Value genMergeBits(mlir::Type, llvm::ArrayRef<mlir::Value>);
525   fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
526   fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
527   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
528   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
529   void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
530   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
531   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
532   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
533   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
534   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
535   mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>);
536   mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
537   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
538   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
539   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
540   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
541   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
542   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
543   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
544   mlir::Value genRRSpacing(mlir::Type resultType,
545                            llvm::ArrayRef<mlir::Value> args);
546   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
547   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
548   mlir::Value genSetExponent(mlir::Type resultType,
549                              llvm::ArrayRef<mlir::Value> args);
550   template <typename Shift>
551   mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
552   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
553   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
554   mlir::Value genSpacing(mlir::Type resultType,
555                          llvm::ArrayRef<mlir::Value> args);
556   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
557   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
558   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
559   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
560   fir::ExtendedValue genTransfer(mlir::Type,
561                                  llvm::ArrayRef<fir::ExtendedValue>);
562   fir::ExtendedValue genTranspose(mlir::Type,
563                                   llvm::ArrayRef<fir::ExtendedValue>);
564   fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
565   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
566   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
567   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
568   /// Implement all conversion functions like DBLE, the first argument is
569   /// the value to convert. There may be an additional KIND arguments that
570   /// is ignored because this is already reflected in the result type.
571   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
572 
573   /// Define the different FIR generators that can be mapped to intrinsic to
574   /// generate the related code.
575   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
576   using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
577   using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime);
578   using Generator =
579       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
580 
581   /// All generators can be outlined. This will build a function named
582   /// "fir."+ <generic name> + "." + <result type code> and generate the
583   /// intrinsic implementation inside instead of at the intrinsic call sites.
584   /// This can be used to keep the FIR more readable. Only one function will
585   /// be generated for all the similar calls in a program.
586   /// If the Generator is nullptr, the wrapper uses genRuntimeCall.
587   template <typename GeneratorType>
588   mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name,
589                                mlir::Type resultType,
590                                llvm::ArrayRef<mlir::Value> args);
591   template <typename GeneratorType>
592   fir::ExtendedValue
593   outlineInExtendedWrapper(GeneratorType, llvm::StringRef name,
594                            llvm::Optional<mlir::Type> resultType,
595                            llvm::ArrayRef<fir::ExtendedValue> args);
596 
597   template <typename GeneratorType>
598   mlir::func::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
599                                 mlir::FunctionType,
600                                 bool loadRefArguments = false);
601 
602   /// Generate calls to ElementalGenerator, handling the elemental aspects
603   template <typename GeneratorType>
604   fir::ExtendedValue
605   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
606                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
607 
608   /// Helper to invoke code generator for the intrinsics given arguments.
609   mlir::Value invokeGenerator(ElementalGenerator generator,
610                               mlir::Type resultType,
611                               llvm::ArrayRef<mlir::Value> args);
612   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
613                               mlir::Type resultType,
614                               llvm::ArrayRef<mlir::Value> args);
615   mlir::Value invokeGenerator(ExtendedGenerator generator,
616                               mlir::Type resultType,
617                               llvm::ArrayRef<mlir::Value> args);
618   mlir::Value invokeGenerator(SubroutineGenerator generator,
619                               llvm::ArrayRef<mlir::Value> args);
620 
621   /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
622   /// intrinsic if it is not defined yet.
623   mlir::SymbolRefAttr
624   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
625                                         mlir::FunctionType signature);
626 
627   /// Add clean-up for \p temp to the current statement context;
628   void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
629   /// Helper function for generating code clean-up for result descriptors
630   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
631                                        mlir::Type resultType,
632                                        llvm::StringRef errMsg);
633 
634   fir::FirOpBuilder &builder;
635   mlir::Location loc;
636   Fortran::lower::StatementContext *stmtCtx;
637 };
638 
639 struct IntrinsicDummyArgument {
640   const char *name = nullptr;
641   Fortran::lower::LowerIntrinsicArgAs lowerAs =
642       Fortran::lower::LowerIntrinsicArgAs::Value;
643   bool handleDynamicOptional = false;
644 };
645 
646 struct Fortran::lower::IntrinsicArgumentLoweringRules {
647   /// There is no more than 7 non repeated arguments in Fortran intrinsics.
648   IntrinsicDummyArgument args[7];
649   constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
650 };
651 
652 /// Structure describing what needs to be done to lower intrinsic "name".
653 struct IntrinsicHandler {
654   const char *name;
655   IntrinsicLibrary::Generator generator;
656   // The following may be omitted in the table below.
657   Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
658   bool isElemental = true;
659   /// Code heavy intrinsic can be outlined to make FIR
660   /// more readable.
661   bool outline = false;
662 };
663 
664 constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
665 constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
666 constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
667 constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
668 using I = IntrinsicLibrary;
669 
670 /// Flag to indicate that an intrinsic argument has to be handled as
671 /// being dynamically optional (e.g. special handling when actual
672 /// argument is an optional variable in the current scope).
673 static constexpr bool handleDynamicOptional = true;
674 
675 /// Table that drives the fir generation depending on the intrinsic.
676 /// one to one mapping with Fortran arguments. If no mapping is
677 /// defined here for a generic intrinsic, genRuntimeCall will be called
678 /// to look for a match in the runtime a emit a call. Note that the argument
679 /// lowering rules for an intrinsic need to be provided only if at least one
680 /// argument must not be lowered by value. In which case, the lowering rules
681 /// should be provided for all the intrinsic arguments for completeness.
682 static constexpr IntrinsicHandler handlers[]{
683     {"abs", &I::genAbs},
684     {"achar", &I::genChar},
685     {"adjustl",
686      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
687      {{{"string", asAddr}}},
688      /*isElemental=*/true},
689     {"adjustr",
690      &I::genAdjustRtCall<fir::runtime::genAdjustR>,
691      {{{"string", asAddr}}},
692      /*isElemental=*/true},
693     {"aimag", &I::genAimag},
694     {"aint", &I::genAint},
695     {"all",
696      &I::genAll,
697      {{{"mask", asAddr}, {"dim", asValue}}},
698      /*isElemental=*/false},
699     {"allocated",
700      &I::genAllocated,
701      {{{"array", asInquired}, {"scalar", asInquired}}},
702      /*isElemental=*/false},
703     {"anint", &I::genAnint},
704     {"any",
705      &I::genAny,
706      {{{"mask", asAddr}, {"dim", asValue}}},
707      /*isElemental=*/false},
708     {"associated",
709      &I::genAssociated,
710      {{{"pointer", asInquired}, {"target", asInquired}}},
711      /*isElemental=*/false},
712     {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
713     {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
714     {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
715     {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
716     {"btest", &I::genBtest},
717     {"ceiling", &I::genCeiling},
718     {"char", &I::genChar},
719     {"cmplx",
720      &I::genCmplx,
721      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
722     {"command_argument_count", &I::genCommandArgumentCount},
723     {"conjg", &I::genConjg},
724     {"count",
725      &I::genCount,
726      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
727      /*isElemental=*/false},
728     {"cpu_time",
729      &I::genCpuTime,
730      {{{"time", asAddr}}},
731      /*isElemental=*/false},
732     {"cshift",
733      &I::genCshift,
734      {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
735      /*isElemental=*/false},
736     {"date_and_time",
737      &I::genDateAndTime,
738      {{{"date", asAddr, handleDynamicOptional},
739        {"time", asAddr, handleDynamicOptional},
740        {"zone", asAddr, handleDynamicOptional},
741        {"values", asBox, handleDynamicOptional}}},
742      /*isElemental=*/false},
743     {"dble", &I::genConversion},
744     {"dim", &I::genDim},
745     {"dot_product",
746      &I::genDotProduct,
747      {{{"vector_a", asBox}, {"vector_b", asBox}}},
748      /*isElemental=*/false},
749     {"dprod", &I::genDprod},
750     {"dshiftl", &I::genDshiftl},
751     {"dshiftr", &I::genDshiftr},
752     {"eoshift",
753      &I::genEoshift,
754      {{{"array", asBox},
755        {"shift", asAddr},
756        {"boundary", asBox, handleDynamicOptional},
757        {"dim", asValue}}},
758      /*isElemental=*/false},
759     {"exit",
760      &I::genExit,
761      {{{"status", asValue, handleDynamicOptional}}},
762      /*isElemental=*/false},
763     {"exponent", &I::genExponent},
764     {"floor", &I::genFloor},
765     {"fraction", &I::genFraction},
766     {"get_command_argument",
767      &I::genGetCommandArgument,
768      {{{"number", asValue},
769        {"value", asBox, handleDynamicOptional},
770        {"length", asAddr},
771        {"status", asAddr},
772        {"errmsg", asBox, handleDynamicOptional}}},
773      /*isElemental=*/false},
774     {"get_environment_variable",
775      &I::genGetEnvironmentVariable,
776      {{{"name", asBox},
777        {"value", asBox, handleDynamicOptional},
778        {"length", asAddr},
779        {"status", asAddr},
780        {"trim_name", asAddr},
781        {"errmsg", asBox, handleDynamicOptional}}},
782      /*isElemental=*/false},
783     {"iachar", &I::genIchar},
784     {"iand", &I::genIand},
785     {"ibclr", &I::genIbclr},
786     {"ibits", &I::genIbits},
787     {"ibset", &I::genIbset},
788     {"ichar", &I::genIchar},
789     {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
790     {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
791     {"ieee_is_finite", &I::genIeeeIsFinite},
792     {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
793     {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
794     {"ieor", &I::genIeor},
795     {"index",
796      &I::genIndex,
797      {{{"string", asAddr},
798        {"substring", asAddr},
799        {"back", asValue, handleDynamicOptional},
800        {"kind", asValue}}}},
801     {"ior", &I::genIor},
802     {"ishft", &I::genIshft},
803     {"ishftc", &I::genIshftc},
804     {"lbound",
805      &I::genLbound,
806      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
807      /*isElemental=*/false},
808     {"leadz", &I::genLeadz},
809     {"len",
810      &I::genLen,
811      {{{"string", asInquired}, {"kind", asValue}}},
812      /*isElemental=*/false},
813     {"len_trim", &I::genLenTrim},
814     {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
815     {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
816     {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
817     {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
818     {"maskl", &I::genMask<mlir::arith::ShLIOp>},
819     {"maskr", &I::genMask<mlir::arith::ShRUIOp>},
820     {"matmul",
821      &I::genMatmul,
822      {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
823      /*isElemental=*/false},
824     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
825     {"maxloc",
826      &I::genMaxloc,
827      {{{"array", asBox},
828        {"dim", asValue},
829        {"mask", asBox, handleDynamicOptional},
830        {"kind", asValue},
831        {"back", asValue, handleDynamicOptional}}},
832      /*isElemental=*/false},
833     {"maxval",
834      &I::genMaxval,
835      {{{"array", asBox},
836        {"dim", asValue},
837        {"mask", asBox, handleDynamicOptional}}},
838      /*isElemental=*/false},
839     {"merge", &I::genMerge},
840     {"merge_bits", &I::genMergeBits},
841     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
842     {"minloc",
843      &I::genMinloc,
844      {{{"array", asBox},
845        {"dim", asValue},
846        {"mask", asBox, handleDynamicOptional},
847        {"kind", asValue},
848        {"back", asValue, handleDynamicOptional}}},
849      /*isElemental=*/false},
850     {"minval",
851      &I::genMinval,
852      {{{"array", asBox},
853        {"dim", asValue},
854        {"mask", asBox, handleDynamicOptional}}},
855      /*isElemental=*/false},
856     {"mod", &I::genMod},
857     {"modulo", &I::genModulo},
858     {"mvbits",
859      &I::genMvbits,
860      {{{"from", asValue},
861        {"frompos", asValue},
862        {"len", asValue},
863        {"to", asAddr},
864        {"topos", asValue}}}},
865     {"nearest", &I::genNearest},
866     {"nint", &I::genNint},
867     {"not", &I::genNot},
868     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
869     {"pack",
870      &I::genPack,
871      {{{"array", asBox},
872        {"mask", asBox},
873        {"vector", asBox, handleDynamicOptional}}},
874      /*isElemental=*/false},
875     {"popcnt", &I::genPopcnt},
876     {"poppar", &I::genPoppar},
877     {"present",
878      &I::genPresent,
879      {{{"a", asInquired}}},
880      /*isElemental=*/false},
881     {"product",
882      &I::genProduct,
883      {{{"array", asBox},
884        {"dim", asValue},
885        {"mask", asBox, handleDynamicOptional}}},
886      /*isElemental=*/false},
887     {"random_init",
888      &I::genRandomInit,
889      {{{"repeatable", asValue}, {"image_distinct", asValue}}},
890      /*isElemental=*/false},
891     {"random_number",
892      &I::genRandomNumber,
893      {{{"harvest", asBox}}},
894      /*isElemental=*/false},
895     {"random_seed",
896      &I::genRandomSeed,
897      {{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
898      /*isElemental=*/false},
899     {"repeat",
900      &I::genRepeat,
901      {{{"string", asAddr}, {"ncopies", asValue}}},
902      /*isElemental=*/false},
903     {"reshape",
904      &I::genReshape,
905      {{{"source", asBox},
906        {"shape", asBox},
907        {"pad", asBox, handleDynamicOptional},
908        {"order", asBox, handleDynamicOptional}}},
909      /*isElemental=*/false},
910     {"rrspacing", &I::genRRSpacing},
911     {"scale",
912      &I::genScale,
913      {{{"x", asValue}, {"i", asValue}}},
914      /*isElemental=*/true},
915     {"scan",
916      &I::genScan,
917      {{{"string", asAddr},
918        {"set", asAddr},
919        {"back", asValue, handleDynamicOptional},
920        {"kind", asValue}}},
921      /*isElemental=*/true},
922     {"set_exponent", &I::genSetExponent},
923     {"shifta", &I::genShift<mlir::arith::ShRSIOp>},
924     {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
925     {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
926     {"sign", &I::genSign},
927     {"size",
928      &I::genSize,
929      {{{"array", asBox},
930        {"dim", asAddr, handleDynamicOptional},
931        {"kind", asValue}}},
932      /*isElemental=*/false},
933     {"spacing", &I::genSpacing},
934     {"spread",
935      &I::genSpread,
936      {{{"source", asAddr}, {"dim", asValue}, {"ncopies", asValue}}},
937      /*isElemental=*/false},
938     {"sum",
939      &I::genSum,
940      {{{"array", asBox},
941        {"dim", asValue},
942        {"mask", asBox, handleDynamicOptional}}},
943      /*isElemental=*/false},
944     {"system_clock",
945      &I::genSystemClock,
946      {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
947      /*isElemental=*/false},
948     {"trailz", &I::genTrailz},
949     {"transfer",
950      &I::genTransfer,
951      {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
952      /*isElemental=*/false},
953     {"transpose",
954      &I::genTranspose,
955      {{{"matrix", asAddr}}},
956      /*isElemental=*/false},
957     {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
958     {"ubound",
959      &I::genUbound,
960      {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
961      /*isElemental=*/false},
962     {"unpack",
963      &I::genUnpack,
964      {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
965      /*isElemental=*/false},
966     {"verify",
967      &I::genVerify,
968      {{{"string", asAddr},
969        {"set", asAddr},
970        {"back", asValue, handleDynamicOptional},
971        {"kind", asValue}}},
972      /*isElemental=*/true},
973 };
974 
975 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
976   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
977     return name.compare(handler.name) > 0;
978   };
979   auto result =
980       std::lower_bound(std::begin(handlers), std::end(handlers), name, compare);
981   return result != std::end(handlers) && result->name == name ? result
982                                                               : nullptr;
983 }
984 
985 /// To make fir output more readable for debug, one can outline all intrinsic
986 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
987 static llvm::cl::opt<bool> outlineAllIntrinsics(
988     "outline-intrinsics",
989     llvm::cl::desc(
990         "Lower all intrinsic procedure implementation in their own functions"),
991     llvm::cl::init(false));
992 
993 //===----------------------------------------------------------------------===//
994 // Math runtime description and matching utility
995 //===----------------------------------------------------------------------===//
996 
997 /// Command line option to control how math operations are lowered
998 /// into MLIR.
999 /// Going forward, most of the math operations have to be lowered
1000 /// to some MLIR dialect operations or libm calls, if the corresponding
1001 /// MLIR operation is not available or not reasonable to create
1002 /// (e.g. there are no known optimization opportunities for the math
1003 /// operation in MLIR).
1004 ///
1005 /// In general, exposing MLIR operations early can potentially enable more
1006 /// MLIR optimizations.
1007 llvm::cl::opt<bool> lowerEarlyToLibCall(
1008     "lower-math-early",
1009     llvm::cl::desc("Controls when to lower Math intrinsics to library calls"),
1010     llvm::cl::init(true));
1011 
1012 /// Command line option to modify math runtime behavior used to implement
1013 /// intrinsics. This option applies both to early and late math-lowering modes.
1014 enum MathRuntimeVersion {
1015   fastVersion,
1016   relaxedVersion,
1017   preciseVersion,
1018   llvmOnly
1019 };
1020 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
1021     "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),
1022     llvm::cl::values(
1023         clEnumValN(fastVersion, "fast", "use fast runtime behavior"),
1024         clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),
1025         clEnumValN(preciseVersion, "precise", "use precise runtime behavior"),
1026         clEnumValN(llvmOnly, "llvm",
1027                    "only use LLVM intrinsics (may be incomplete)")),
1028     llvm::cl::init(fastVersion));
1029 
1030 struct RuntimeFunction {
1031   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1032   using Key = std::string_view;
1033   // Needed for implicit compare with keys.
1034   constexpr operator Key() const { return key; }
1035   Key key; // intrinsic name
1036 
1037   // Name of a runtime function that implements the operation.
1038   llvm::StringRef symbol;
1039   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1040 };
1041 
1042 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
1043   {#name, #func, fir::runtime::RuntimeTableKey<decltype(func)>::getTypeModel()},
1044 static constexpr RuntimeFunction pgmathFast[] = {
1045 #define PGMATH_FAST
1046 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1047 #include "flang/Evaluate/pgmath.h.inc"
1048 };
1049 static constexpr RuntimeFunction pgmathRelaxed[] = {
1050 #define PGMATH_RELAXED
1051 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1052 #include "flang/Evaluate/pgmath.h.inc"
1053 };
1054 static constexpr RuntimeFunction pgmathPrecise[] = {
1055 #define PGMATH_PRECISE
1056 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1057 #include "flang/Evaluate/pgmath.h.inc"
1058 };
1059 
1060 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
1061   mlir::Type t = mlir::FloatType::getF32(context);
1062   return mlir::FunctionType::get(context, {t}, {t});
1063 }
1064 
1065 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
1066   mlir::Type t = mlir::FloatType::getF64(context);
1067   return mlir::FunctionType::get(context, {t}, {t});
1068 }
1069 
1070 static mlir::FunctionType genF128F128FuncType(mlir::MLIRContext *context) {
1071   mlir::Type t = mlir::FloatType::getF128(context);
1072   return mlir::FunctionType::get(context, {t}, {t});
1073 }
1074 
1075 static mlir::FunctionType genF32F32F32FuncType(mlir::MLIRContext *context) {
1076   auto t = mlir::FloatType::getF32(context);
1077   return mlir::FunctionType::get(context, {t, t}, {t});
1078 }
1079 
1080 static mlir::FunctionType genF64F64F64FuncType(mlir::MLIRContext *context) {
1081   auto t = mlir::FloatType::getF64(context);
1082   return mlir::FunctionType::get(context, {t, t}, {t});
1083 }
1084 
1085 static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) {
1086   auto t = mlir::FloatType::getF80(context);
1087   return mlir::FunctionType::get(context, {t, t}, {t});
1088 }
1089 
1090 static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) {
1091   auto t = mlir::FloatType::getF128(context);
1092   return mlir::FunctionType::get(context, {t, t}, {t});
1093 }
1094 
1095 template <int Bits>
1096 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
1097   auto t = mlir::FloatType::getF64(context);
1098   auto r = mlir::IntegerType::get(context, Bits);
1099   return mlir::FunctionType::get(context, {t}, {r});
1100 }
1101 
1102 template <int Bits>
1103 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
1104   auto t = mlir::FloatType::getF32(context);
1105   auto r = mlir::IntegerType::get(context, Bits);
1106   return mlir::FunctionType::get(context, {t}, {r});
1107 }
1108 
1109 template <int Bits>
1110 static mlir::FunctionType genF64F64IntFuncType(mlir::MLIRContext *context) {
1111   auto ftype = mlir::FloatType::getF64(context);
1112   auto itype = mlir::IntegerType::get(context, Bits);
1113   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1114 }
1115 
1116 template <int Bits>
1117 static mlir::FunctionType genF32F32IntFuncType(mlir::MLIRContext *context) {
1118   auto ftype = mlir::FloatType::getF32(context);
1119   auto itype = mlir::IntegerType::get(context, Bits);
1120   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1121 }
1122 
1123 /// Callback type for generating lowering for a math operation.
1124 using MathGeneratorTy = mlir::Value (*)(fir::FirOpBuilder &, mlir::Location,
1125                                         llvm::StringRef, mlir::FunctionType,
1126                                         llvm::ArrayRef<mlir::Value>);
1127 
1128 struct MathOperation {
1129   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1130   using Key = std::string_view;
1131   // Needed for implicit compare with keys.
1132   constexpr operator Key() const { return key; }
1133   // Intrinsic name.
1134   Key key;
1135 
1136   // Name of a runtime function that implements the operation.
1137   llvm::StringRef runtimeFunc;
1138   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1139 
1140   // A callback to generate FIR for the intrinsic defined by 'key'.
1141   // A callback may generate either dedicated MLIR operation(s) or
1142   // a function call to a runtime function with name defined by
1143   // 'runtimeFunc'.
1144   MathGeneratorTy funcGenerator;
1145 };
1146 
1147 static mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,
1148                               llvm::StringRef libFuncName,
1149                               mlir::FunctionType libFuncType,
1150                               llvm::ArrayRef<mlir::Value> args) {
1151   LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName
1152                           << "' call with type ";
1153              libFuncType.dump(); llvm::dbgs() << "\n");
1154   mlir::func::FuncOp funcOp =
1155       builder.addNamedFunction(loc, libFuncName, libFuncType);
1156   // TODO: ensure 'strictfp' setting on the call for "precise/strict"
1157   //       FP mode. Set appropriate Fast-Math Flags otherwise.
1158   // TODO: we should also mark as many libm function as possible
1159   //       with 'pure' attribute (of course, not in strict FP mode).
1160   auto libCall = builder.create<fir::CallOp>(loc, funcOp, args);
1161   LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
1162   return libCall.getResult(0);
1163 }
1164 
1165 template <typename T>
1166 static mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
1167                              llvm::StringRef mathLibFuncName,
1168                              mlir::FunctionType mathLibFuncType,
1169                              llvm::ArrayRef<mlir::Value> args) {
1170   // TODO: we have to annotate the math operations with flags
1171   //       that will allow to define FP accuracy/exception
1172   //       behavior per operation, so that after early multi-module
1173   //       MLIR inlining we can distiguish operation that were
1174   //       compiled with different settings.
1175   //       Suggestion:
1176   //         * For "relaxed" FP mode set all Fast-Math Flags
1177   //           (see "[RFC] FastMath flags support in MLIR (arith dialect)"
1178   //           topic at discourse.llvm.org).
1179   //         * For "fast" FP mode set all Fast-Math Flags except 'afn'.
1180   //         * For "precise/strict" FP mode generate fir.calls to libm
1181   //           entries and annotate them with an attribute that will
1182   //           end up transformed into 'strictfp' LLVM attribute (TBD).
1183   //           Elsewhere, "precise/strict" FP mode should also set
1184   //           'strictfp' for all user functions and calls so that
1185   //           LLVM backend does the right job.
1186   //         * Operations that cannot be reasonably optimized in MLIR
1187   //           can be also lowered to libm calls for "fast" and "relaxed"
1188   //           modes.
1189   mlir::Value result;
1190   if (mathRuntimeVersion == preciseVersion) {
1191     result = genLibCall(builder, loc, mathLibFuncName, mathLibFuncType, args);
1192   } else {
1193     LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
1194                             << "' operation with type ";
1195                mathLibFuncType.dump(); llvm::dbgs() << "\n");
1196     result = builder.create<T>(loc, args);
1197   }
1198   LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1199   return result;
1200 }
1201 
1202 /// Mapping between mathematical intrinsic operations and MLIR operations
1203 /// of some appropriate dialect (math, complex, etc.) or libm calls.
1204 /// TODO: support remaining Fortran math intrinsics.
1205 ///       See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\
1206 ///       Intrinsic-Procedures.html for a reference.
1207 static constexpr MathOperation mathOperations[] = {
1208     {"abs", "fabsf", genF32F32FuncType, genMathOp<mlir::math::AbsOp>},
1209     {"abs", "fabs", genF64F64FuncType, genMathOp<mlir::math::AbsOp>},
1210     {"abs", "llvm.fabs.f128", genF128F128FuncType,
1211      genMathOp<mlir::math::AbsOp>},
1212     // llvm.trunc behaves the same way as libm's trunc.
1213     {"aint", "llvm.trunc.f32", genF32F32FuncType, genLibCall},
1214     {"aint", "llvm.trunc.f64", genF64F64FuncType, genLibCall},
1215     // llvm.round behaves the same way as libm's round.
1216     {"anint", "llvm.round.f32", genF32F32FuncType,
1217      genMathOp<mlir::LLVM::RoundOp>},
1218     {"anint", "llvm.round.f64", genF64F64FuncType,
1219      genMathOp<mlir::LLVM::RoundOp>},
1220     {"atan", "atanf", genF32F32FuncType, genMathOp<mlir::math::AtanOp>},
1221     {"atan", "atan", genF64F64FuncType, genMathOp<mlir::math::AtanOp>},
1222     {"atan2", "atan2f", genF32F32F32FuncType, genMathOp<mlir::math::Atan2Op>},
1223     {"atan2", "atan2", genF64F64F64FuncType, genMathOp<mlir::math::Atan2Op>},
1224     // math::CeilOp returns a real, while Fortran CEILING returns integer.
1225     {"ceil", "ceilf", genF32F32FuncType, genMathOp<mlir::math::CeilOp>},
1226     {"ceil", "ceil", genF64F64FuncType, genMathOp<mlir::math::CeilOp>},
1227     {"cos", "cosf", genF32F32FuncType, genMathOp<mlir::math::CosOp>},
1228     {"cos", "cos", genF64F64FuncType, genMathOp<mlir::math::CosOp>},
1229     {"cosh", "coshf", genF32F32FuncType, genLibCall},
1230     {"cosh", "cosh", genF64F64FuncType, genLibCall},
1231     {"erf", "erff", genF32F32FuncType, genMathOp<mlir::math::ErfOp>},
1232     {"erf", "erf", genF64F64FuncType, genMathOp<mlir::math::ErfOp>},
1233     {"exp", "expf", genF32F32FuncType, genMathOp<mlir::math::ExpOp>},
1234     {"exp", "exp", genF64F64FuncType, genMathOp<mlir::math::ExpOp>},
1235     // math::FloorOp returns a real, while Fortran FLOOR returns integer.
1236     {"floor", "floorf", genF32F32FuncType, genMathOp<mlir::math::FloorOp>},
1237     {"floor", "floor", genF64F64FuncType, genMathOp<mlir::math::FloorOp>},
1238     {"hypot", "hypotf", genF32F32F32FuncType, genLibCall},
1239     {"hypot", "hypot", genF64F64F64FuncType, genLibCall},
1240     {"log", "logf", genF32F32FuncType, genMathOp<mlir::math::LogOp>},
1241     {"log", "log", genF64F64FuncType, genMathOp<mlir::math::LogOp>},
1242     {"log10", "log10f", genF32F32FuncType, genMathOp<mlir::math::Log10Op>},
1243     {"log10", "log10", genF64F64FuncType, genMathOp<mlir::math::Log10Op>},
1244     // llvm.lround behaves the same way as libm's lround.
1245     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>, genLibCall},
1246     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>, genLibCall},
1247     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>, genLibCall},
1248     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>, genLibCall},
1249     {"pow", "powf", genF32F32F32FuncType, genMathOp<mlir::math::PowFOp>},
1250     {"pow", "pow", genF64F64F64FuncType, genMathOp<mlir::math::PowFOp>},
1251     // TODO: add PowIOp in math and complex dialects.
1252     {"pow", "llvm.powi.f32.i32", genF32F32IntFuncType<32>, genLibCall},
1253     {"pow", "llvm.powi.f64.i32", genF64F64IntFuncType<32>, genLibCall},
1254     {"sign", "copysignf", genF32F32F32FuncType,
1255      genMathOp<mlir::math::CopySignOp>},
1256     {"sign", "copysign", genF64F64F64FuncType,
1257      genMathOp<mlir::math::CopySignOp>},
1258     {"sign", "copysignl", genF80F80F80FuncType,
1259      genMathOp<mlir::math::CopySignOp>},
1260     {"sign", "llvm.copysign.f128", genF128F128F128FuncType,
1261      genMathOp<mlir::math::CopySignOp>},
1262     {"sin", "sinf", genF32F32FuncType, genMathOp<mlir::math::SinOp>},
1263     {"sin", "sin", genF64F64FuncType, genMathOp<mlir::math::SinOp>},
1264     {"sinh", "sinhf", genF32F32FuncType, genLibCall},
1265     {"sinh", "sinh", genF64F64FuncType, genLibCall},
1266     {"sqrt", "sqrtf", genF32F32FuncType, genMathOp<mlir::math::SqrtOp>},
1267     {"sqrt", "sqrt", genF64F64FuncType, genMathOp<mlir::math::SqrtOp>},
1268     {"tan", "tanf", genF32F32FuncType, genMathOp<mlir::math::TanOp>},
1269     {"tan", "tan", genF64F64FuncType, genMathOp<mlir::math::TanOp>},
1270     {"tanh", "tanhf", genF32F32FuncType, genMathOp<mlir::math::TanhOp>},
1271     {"tanh", "tanh", genF64F64FuncType, genMathOp<mlir::math::TanhOp>},
1272 };
1273 
1274 // Note: These are also defined as operations in LLVM dialect. See if this
1275 // can be use and has advantages.
1276 // TODO: remove this table, since the late math lowering should
1277 //       replace it and generate proper MLIR operations rather
1278 //       than llvm intrinsic calls, which still look like generic
1279 //       calls to MLIR and do not enable many optimizations.
1280 //       When late math lowering is able to handle all math operations
1281 //       described in pgmath.h.inc and in the table below, we can
1282 //       switch to it by default.
1283 static constexpr RuntimeFunction llvmIntrinsics[] = {
1284     {"abs", "llvm.fabs.f32", genF32F32FuncType},
1285     {"abs", "llvm.fabs.f64", genF64F64FuncType},
1286     {"abs", "llvm.fabs.f128", genF128F128FuncType},
1287     {"aint", "llvm.trunc.f32", genF32F32FuncType},
1288     {"aint", "llvm.trunc.f64", genF64F64FuncType},
1289     {"anint", "llvm.round.f32", genF32F32FuncType},
1290     {"anint", "llvm.round.f64", genF64F64FuncType},
1291     {"atan", "atanf", genF32F32FuncType},
1292     {"atan", "atan", genF64F64FuncType},
1293     // ceil is used for CEILING but is different, it returns a real.
1294     {"ceil", "llvm.ceil.f32", genF32F32FuncType},
1295     {"ceil", "llvm.ceil.f64", genF64F64FuncType},
1296     {"cos", "llvm.cos.f32", genF32F32FuncType},
1297     {"cos", "llvm.cos.f64", genF64F64FuncType},
1298     {"cosh", "coshf", genF32F32FuncType},
1299     {"cosh", "cosh", genF64F64FuncType},
1300     {"exp", "llvm.exp.f32", genF32F32FuncType},
1301     {"exp", "llvm.exp.f64", genF64F64FuncType},
1302     // llvm.floor is used for FLOOR, but returns real.
1303     {"floor", "llvm.floor.f32", genF32F32FuncType},
1304     {"floor", "llvm.floor.f64", genF64F64FuncType},
1305     {"log", "llvm.log.f32", genF32F32FuncType},
1306     {"log", "llvm.log.f64", genF64F64FuncType},
1307     {"log10", "llvm.log10.f32", genF32F32FuncType},
1308     {"log10", "llvm.log10.f64", genF64F64FuncType},
1309     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>},
1310     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>},
1311     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>},
1312     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>},
1313     {"pow", "llvm.pow.f32", genF32F32F32FuncType},
1314     {"pow", "llvm.pow.f64", genF64F64F64FuncType},
1315     {"sign", "llvm.copysign.f32", genF32F32F32FuncType},
1316     {"sign", "llvm.copysign.f64", genF64F64F64FuncType},
1317     {"sign", "llvm.copysign.f80", genF80F80F80FuncType},
1318     {"sign", "llvm.copysign.f128", genF128F128F128FuncType},
1319     {"sin", "llvm.sin.f32", genF32F32FuncType},
1320     {"sin", "llvm.sin.f64", genF64F64FuncType},
1321     {"sinh", "sinhf", genF32F32FuncType},
1322     {"sinh", "sinh", genF64F64FuncType},
1323     {"sqrt", "llvm.sqrt.f32", genF32F32FuncType},
1324     {"sqrt", "llvm.sqrt.f64", genF64F64FuncType},
1325 };
1326 
1327 // This helper class computes a "distance" between two function types.
1328 // The distance measures how many narrowing conversions of actual arguments
1329 // and result of "from" must be made in order to use "to" instead of "from".
1330 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1331 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1332 // if no implementation of ACOS(REAL(10)) is available, it is better to use
1333 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1334 // Note that this is not a symmetric distance and the order of "from" and "to"
1335 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1336 // may be safe to replace foo by bar, but not the opposite.
1337 class FunctionDistance {
1338 public:
1339   FunctionDistance() : infinite{true} {}
1340 
1341   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1342     unsigned nInputs = from.getNumInputs();
1343     unsigned nResults = from.getNumResults();
1344     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1345       infinite = true;
1346     } else {
1347       for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1348         addArgumentDistance(from.getInput(i), to.getInput(i));
1349       for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1350         addResultDistance(to.getResult(i), from.getResult(i));
1351     }
1352   }
1353 
1354   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1355   /// false if both d1 and d2 are infinite. This implies that
1356   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1357   bool isSmallerThan(const FunctionDistance &d) const {
1358     return !infinite &&
1359            (d.infinite || std::lexicographical_compare(
1360                               conversions.begin(), conversions.end(),
1361                               d.conversions.begin(), d.conversions.end()));
1362   }
1363 
1364   bool isLosingPrecision() const {
1365     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1366   }
1367 
1368   bool isInfinite() const { return infinite; }
1369 
1370 private:
1371   enum class Conversion { Forbidden, None, Narrow, Extend };
1372 
1373   void addArgumentDistance(mlir::Type from, mlir::Type to) {
1374     switch (conversionBetweenTypes(from, to)) {
1375     case Conversion::Forbidden:
1376       infinite = true;
1377       break;
1378     case Conversion::None:
1379       break;
1380     case Conversion::Narrow:
1381       conversions[narrowingArg]++;
1382       break;
1383     case Conversion::Extend:
1384       conversions[nonNarrowingArg]++;
1385       break;
1386     }
1387   }
1388 
1389   void addResultDistance(mlir::Type from, mlir::Type to) {
1390     switch (conversionBetweenTypes(from, to)) {
1391     case Conversion::Forbidden:
1392       infinite = true;
1393       break;
1394     case Conversion::None:
1395       break;
1396     case Conversion::Narrow:
1397       conversions[nonExtendingResult]++;
1398       break;
1399     case Conversion::Extend:
1400       conversions[extendingResult]++;
1401       break;
1402     }
1403   }
1404 
1405   // Floating point can be mlir::FloatType or fir::real
1406   static unsigned getFloatingPointWidth(mlir::Type t) {
1407     if (auto f{t.dyn_cast<mlir::FloatType>()})
1408       return f.getWidth();
1409     // FIXME: Get width another way for fir.real/complex
1410     // - use fir/KindMapping.h and llvm::Type
1411     // - or use evaluate/type.h
1412     if (auto r{t.dyn_cast<fir::RealType>()})
1413       return r.getFKind() * 4;
1414     if (auto cplx{t.dyn_cast<fir::ComplexType>()})
1415       return cplx.getFKind() * 4;
1416     llvm_unreachable("not a floating-point type");
1417   }
1418 
1419   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1420     if (from == to)
1421       return Conversion::None;
1422 
1423     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
1424       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
1425         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1426                                                          : Conversion::Extend;
1427       }
1428     }
1429 
1430     if (fir::isa_real(from) && fir::isa_real(to)) {
1431       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
1432                  ? Conversion::Narrow
1433                  : Conversion::Extend;
1434     }
1435 
1436     if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
1437       if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
1438         return getFloatingPointWidth(fromCplxTy) >
1439                        getFloatingPointWidth(toCplxTy)
1440                    ? Conversion::Narrow
1441                    : Conversion::Extend;
1442       }
1443     }
1444     // Notes:
1445     // - No conversion between character types, specialization of runtime
1446     // functions should be made instead.
1447     // - It is not clear there is a use case for automatic conversions
1448     // around Logical and it may damage hidden information in the physical
1449     // storage so do not do it.
1450     return Conversion::Forbidden;
1451   }
1452 
1453   // Below are indexes to access data in conversions.
1454   // The order in data does matter for lexicographical_compare
1455   enum {
1456     narrowingArg = 0,   // usually bad
1457     extendingResult,    // usually bad
1458     nonExtendingResult, // usually ok
1459     nonNarrowingArg,    // usually ok
1460     dataSize
1461   };
1462 
1463   std::array<int, dataSize> conversions = {};
1464   bool infinite = false; // When forbidden conversion or wrong argument number
1465 };
1466 
1467 /// Build mlir::func::FuncOp from runtime symbol description and add
1468 /// fir.runtime attribute.
1469 static mlir::func::FuncOp getFuncOp(mlir::Location loc,
1470                                     fir::FirOpBuilder &builder,
1471                                     const RuntimeFunction &runtime) {
1472   mlir::func::FuncOp function = builder.addNamedFunction(
1473       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
1474   function->setAttr("fir.runtime", builder.getUnitAttr());
1475   return function;
1476 }
1477 
1478 /// Select runtime function that has the smallest distance to the intrinsic
1479 /// function type and that will not imply narrowing arguments or extending the
1480 /// result.
1481 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1482 static mlir::func::FuncOp searchFunctionInLibrary(
1483     mlir::Location loc, fir::FirOpBuilder &builder,
1484     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
1485     llvm::StringRef name, mlir::FunctionType funcType,
1486     const RuntimeFunction **bestNearMatch,
1487     FunctionDistance &bestMatchDistance) {
1488   std::pair<const RuntimeFunction *, const RuntimeFunction *> range =
1489       lib.equal_range(name);
1490   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1491     const RuntimeFunction &impl = *iter;
1492     mlir::FunctionType implType = impl.typeGenerator(builder.getContext());
1493     if (funcType == implType)
1494       return getFuncOp(loc, builder, impl); // exact match
1495 
1496     FunctionDistance distance(funcType, implType);
1497     if (distance.isSmallerThan(bestMatchDistance)) {
1498       *bestNearMatch = &impl;
1499       bestMatchDistance = std::move(distance);
1500     }
1501   }
1502   return {};
1503 }
1504 
1505 using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
1506 static constexpr RtMap mathOps(mathOperations);
1507 static_assert(mathOps.Verify() && "map must be sorted");
1508 
1509 /// Look for a MathOperation entry specifying how to lower a mathematical
1510 /// operation defined by \p name with its result' and operands' types
1511 /// specified in the form of a FunctionType \p funcType.
1512 /// If exact match for the given types is found, then the function
1513 /// returns a pointer to the corresponding MathOperation.
1514 /// Otherwise, the function returns nullptr.
1515 /// If there is a MathOperation that can be used with additional
1516 /// type casts for the operands or/and result (non-exact match),
1517 /// then it is returned via \p bestNearMatch argument, and
1518 /// \p bestMatchDistance specifies the FunctionDistance between
1519 /// the requested operation and the non-exact match.
1520 static const MathOperation *
1521 searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
1522                     mlir::FunctionType funcType,
1523                     const MathOperation **bestNearMatch,
1524                     FunctionDistance &bestMatchDistance) {
1525   auto range = mathOps.equal_range(name);
1526   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1527     const auto &impl = *iter;
1528     auto implType = impl.typeGenerator(builder.getContext());
1529     if (funcType == implType)
1530       return &impl; // exact match
1531 
1532     FunctionDistance distance(funcType, implType);
1533     if (distance.isSmallerThan(bestMatchDistance)) {
1534       *bestNearMatch = &impl;
1535       bestMatchDistance = std::move(distance);
1536     }
1537   }
1538   return nullptr;
1539 }
1540 
1541 /// Implementation of the operation defined by \p name with type
1542 /// \p funcType is not precise, and the actual available implementation
1543 /// is \p distance away from the requested. If using the available
1544 /// implementation results in a precision loss, emit an error message
1545 /// with the given code location \p loc.
1546 static void checkPrecisionLoss(llvm::StringRef name,
1547                                mlir::FunctionType funcType,
1548                                const FunctionDistance &distance,
1549                                mlir::Location loc) {
1550   if (!distance.isLosingPrecision())
1551     return;
1552 
1553   // Using this runtime version requires narrowing the arguments
1554   // or extending the result. It is not numerically safe. There
1555   // is currently no quad math library that was described in
1556   // lowering and could be used here. Emit an error and continue
1557   // generating the code with the narrowing cast so that the user
1558   // can get a complete list of the problematic intrinsic calls.
1559   std::string message("not yet implemented: no math runtime available for '");
1560   llvm::raw_string_ostream sstream(message);
1561   if (name == "pow") {
1562     assert(funcType.getNumInputs() == 2 && "power operator has two arguments");
1563     sstream << funcType.getInput(0) << " ** " << funcType.getInput(1);
1564   } else {
1565     sstream << name << "(";
1566     if (funcType.getNumInputs() > 0)
1567       sstream << funcType.getInput(0);
1568     for (mlir::Type argType : funcType.getInputs().drop_front())
1569       sstream << ", " << argType;
1570     sstream << ")";
1571   }
1572   sstream << "'";
1573   mlir::emitError(loc, message);
1574 }
1575 
1576 /// Search runtime for the best runtime function given an intrinsic name
1577 /// and interface. The interface may not be a perfect match in which case
1578 /// the caller is responsible to insert argument and return value conversions.
1579 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1580 static mlir::func::FuncOp getRuntimeFunction(mlir::Location loc,
1581                                              fir::FirOpBuilder &builder,
1582                                              llvm::StringRef name,
1583                                              mlir::FunctionType funcType) {
1584   const RuntimeFunction *bestNearMatch = nullptr;
1585   FunctionDistance bestMatchDistance;
1586   mlir::func::FuncOp match;
1587   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
1588   static constexpr RtMap pgmathF(pgmathFast);
1589   static_assert(pgmathF.Verify() && "map must be sorted");
1590   static constexpr RtMap pgmathR(pgmathRelaxed);
1591   static_assert(pgmathR.Verify() && "map must be sorted");
1592   static constexpr RtMap pgmathP(pgmathPrecise);
1593   static_assert(pgmathP.Verify() && "map must be sorted");
1594 
1595   if (mathRuntimeVersion == fastVersion) {
1596     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
1597                                     &bestNearMatch, bestMatchDistance);
1598   } else if (mathRuntimeVersion == relaxedVersion) {
1599     match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType,
1600                                     &bestNearMatch, bestMatchDistance);
1601   } else if (mathRuntimeVersion == preciseVersion) {
1602     match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType,
1603                                     &bestNearMatch, bestMatchDistance);
1604   } else {
1605     assert(mathRuntimeVersion == llvmOnly && "unknown math runtime");
1606   }
1607   if (match)
1608     return match;
1609 
1610   // Go through llvm intrinsics if not exact match in libpgmath or if
1611   // mathRuntimeVersion == llvmOnly
1612   static constexpr RtMap llvmIntr(llvmIntrinsics);
1613   static_assert(llvmIntr.Verify() && "map must be sorted");
1614   if (mlir::func::FuncOp exactMatch =
1615           searchFunctionInLibrary(loc, builder, llvmIntr, name, funcType,
1616                                   &bestNearMatch, bestMatchDistance))
1617     return exactMatch;
1618 
1619   if (bestNearMatch != nullptr) {
1620     checkPrecisionLoss(name, funcType, bestMatchDistance, loc);
1621     return getFuncOp(loc, builder, *bestNearMatch);
1622   }
1623   return {};
1624 }
1625 
1626 /// Helpers to get function type from arguments and result type.
1627 static mlir::FunctionType getFunctionType(llvm::Optional<mlir::Type> resultType,
1628                                           llvm::ArrayRef<mlir::Value> arguments,
1629                                           fir::FirOpBuilder &builder) {
1630   llvm::SmallVector<mlir::Type> argTypes;
1631   for (mlir::Value arg : arguments)
1632     argTypes.push_back(arg.getType());
1633   llvm::SmallVector<mlir::Type> resTypes;
1634   if (resultType)
1635     resTypes.push_back(*resultType);
1636   return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,
1637                                  resTypes);
1638 }
1639 
1640 /// fir::ExtendedValue to mlir::Value translation layer
1641 
1642 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1643                                    mlir::Location loc) {
1644   assert(val && "optional unhandled here");
1645   mlir::Type type = val.getType();
1646   mlir::Value base = val;
1647   mlir::IndexType indexType = builder.getIndexType();
1648   llvm::SmallVector<mlir::Value> extents;
1649 
1650   fir::factory::CharacterExprHelper charHelper{builder, loc};
1651   // FIXME: we may want to allow non character scalar here.
1652   if (charHelper.isCharacterScalar(type))
1653     return charHelper.toExtendedValue(val);
1654 
1655   if (auto refType = type.dyn_cast<fir::ReferenceType>())
1656     type = refType.getEleTy();
1657 
1658   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
1659     type = arrayType.getEleTy();
1660     for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1661       if (extent == fir::SequenceType::getUnknownExtent())
1662         break;
1663       extents.emplace_back(
1664           builder.createIntegerConstant(loc, indexType, extent));
1665     }
1666     // Last extent might be missing in case of assumed-size. If more extents
1667     // could not be deduced from type, that's an error (a fir.box should
1668     // have been used in the interface).
1669     if (extents.size() + 1 < arrayType.getShape().size())
1670       mlir::emitError(loc, "cannot retrieve array extents from type");
1671   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
1672     fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1673   }
1674 
1675   if (!extents.empty())
1676     return fir::ArrayBoxValue{base, extents};
1677   return base;
1678 }
1679 
1680 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1681                     mlir::Location loc) {
1682   if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1683     mlir::Value buffer = charBox->getBuffer();
1684     auto buffTy = buffer.getType();
1685     if (buffTy.isa<mlir::FunctionType>())
1686       fir::emitFatalError(
1687           loc, "A character's buffer type cannot be a function type.");
1688     if (buffTy.isa<fir::BoxCharType>())
1689       return buffer;
1690     return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1691         buffer, charBox->getLen());
1692   }
1693 
1694   // FIXME: need to access other ExtendedValue variants and handle them
1695   // properly.
1696   return fir::getBase(val);
1697 }
1698 
1699 //===----------------------------------------------------------------------===//
1700 // IntrinsicLibrary
1701 //===----------------------------------------------------------------------===//
1702 
1703 static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
1704   return name.startswith("c_") || name.startswith("compiler_") ||
1705          name.startswith("ieee_");
1706 }
1707 
1708 /// Return the generic name of an intrinsic module procedure specific name.
1709 /// Remove any "__builtin_" prefix, and any specific suffix of the form
1710 /// {_[ail]?[0-9]+}*, such as _1 or _a4.
1711 llvm::StringRef genericName(llvm::StringRef specificName) {
1712   const std::string builtin = "__builtin_";
1713   llvm::StringRef name = specificName.startswith(builtin)
1714                              ? specificName.drop_front(builtin.size())
1715                              : specificName;
1716   size_t size = name.size();
1717   if (isIntrinsicModuleProcedure(name))
1718     while (isdigit(name[size - 1]))
1719       while (name[--size] != '_')
1720         ;
1721   return name.drop_back(name.size() - size);
1722 }
1723 
1724 /// Generate a TODO error message for an as yet unimplemented intrinsic.
1725 void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
1726   if (isIntrinsicModuleProcedure(name))
1727     TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
1728   else
1729     TODO(loc, "intrinsic: " + llvm::Twine(name));
1730 }
1731 
1732 template <typename GeneratorType>
1733 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
1734     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
1735     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1736   llvm::SmallVector<mlir::Value> scalarArgs;
1737   for (const fir::ExtendedValue &arg : args)
1738     if (arg.getUnboxed() || arg.getCharBox())
1739       scalarArgs.emplace_back(fir::getBase(arg));
1740     else
1741       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1742   if (outline)
1743     return outlineInWrapper(generator, name, resultType, scalarArgs);
1744   return invokeGenerator(generator, resultType, scalarArgs);
1745 }
1746 
1747 template <>
1748 fir::ExtendedValue
1749 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
1750     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
1751     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1752   for (const fir::ExtendedValue &arg : args)
1753     if (!arg.getUnboxed() && !arg.getCharBox())
1754       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1755   if (outline)
1756     return outlineInExtendedWrapper(generator, name, resultType, args);
1757   return std::invoke(generator, *this, resultType, args);
1758 }
1759 
1760 template <>
1761 fir::ExtendedValue
1762 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
1763     SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
1764     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1765   for (const fir::ExtendedValue &arg : args)
1766     if (!arg.getUnboxed() && !arg.getCharBox())
1767       // fir::emitFatalError(loc, "nonscalar intrinsic argument");
1768       crashOnMissingIntrinsic(loc, name);
1769   if (outline)
1770     return outlineInExtendedWrapper(generator, name, resultType, args);
1771   std::invoke(generator, *this, args);
1772   return mlir::Value();
1773 }
1774 
1775 static fir::ExtendedValue
1776 invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
1777               const IntrinsicHandler &handler,
1778               llvm::Optional<mlir::Type> resultType,
1779               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1780               IntrinsicLibrary &lib) {
1781   assert(resultType && "expect elemental intrinsic to be functions");
1782   return lib.genElementalCall(generator, handler.name, *resultType, args,
1783                               outline);
1784 }
1785 
1786 static fir::ExtendedValue
1787 invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
1788               const IntrinsicHandler &handler,
1789               llvm::Optional<mlir::Type> resultType,
1790               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1791               IntrinsicLibrary &lib) {
1792   assert(resultType && "expect intrinsic function");
1793   if (handler.isElemental)
1794     return lib.genElementalCall(generator, handler.name, *resultType, args,
1795                                 outline);
1796   if (outline)
1797     return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
1798                                         args);
1799   return std::invoke(generator, lib, *resultType, args);
1800 }
1801 
1802 static fir::ExtendedValue
1803 invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
1804               const IntrinsicHandler &handler,
1805               llvm::Optional<mlir::Type> resultType,
1806               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1807               IntrinsicLibrary &lib) {
1808   if (handler.isElemental)
1809     return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
1810                                 outline);
1811   if (outline)
1812     return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
1813                                         args);
1814   std::invoke(generator, lib, args);
1815   return mlir::Value{};
1816 }
1817 
1818 fir::ExtendedValue
1819 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
1820                                    llvm::Optional<mlir::Type> resultType,
1821                                    llvm::ArrayRef<fir::ExtendedValue> args) {
1822   llvm::StringRef name = genericName(specificName);
1823   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
1824     bool outline = handler->outline || outlineAllIntrinsics;
1825     return std::visit(
1826         [&](auto &generator) -> fir::ExtendedValue {
1827           return invokeHandler(generator, *handler, resultType, args, outline,
1828                                *this);
1829         },
1830         handler->generator);
1831   }
1832 
1833   if (!resultType)
1834     // Subroutine should have a handler, they are likely missing for now.
1835     crashOnMissingIntrinsic(loc, name);
1836 
1837   // Try the runtime if no special handler was defined for the
1838   // intrinsic being called. Maths runtime only has numerical elemental.
1839   // No optional arguments are expected at this point, the code will
1840   // crash if it gets absent optional.
1841 
1842   // FIXME: using toValue to get the type won't work with array arguments.
1843   llvm::SmallVector<mlir::Value> mlirArgs;
1844   for (const fir::ExtendedValue &extendedVal : args) {
1845     mlir::Value val = toValue(extendedVal, builder, loc);
1846     if (!val)
1847       // If an absent optional gets there, most likely its handler has just
1848       // not yet been defined.
1849       crashOnMissingIntrinsic(loc, name);
1850     mlirArgs.emplace_back(val);
1851   }
1852   mlir::FunctionType soughtFuncType =
1853       getFunctionType(*resultType, mlirArgs, builder);
1854 
1855   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
1856       getRuntimeCallGenerator(name, soughtFuncType);
1857   return genElementalCall(runtimeCallGenerator, name, *resultType, args,
1858                           /*outline=*/outlineAllIntrinsics);
1859 }
1860 
1861 mlir::Value
1862 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
1863                                   mlir::Type resultType,
1864                                   llvm::ArrayRef<mlir::Value> args) {
1865   return std::invoke(generator, *this, resultType, args);
1866 }
1867 
1868 mlir::Value
1869 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
1870                                   mlir::Type resultType,
1871                                   llvm::ArrayRef<mlir::Value> args) {
1872   return generator(builder, loc, args);
1873 }
1874 
1875 mlir::Value
1876 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
1877                                   mlir::Type resultType,
1878                                   llvm::ArrayRef<mlir::Value> args) {
1879   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1880   for (mlir::Value arg : args)
1881     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1882   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
1883   return toValue(extendedResult, builder, loc);
1884 }
1885 
1886 mlir::Value
1887 IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
1888                                   llvm::ArrayRef<mlir::Value> args) {
1889   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1890   for (mlir::Value arg : args)
1891     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1892   std::invoke(generator, *this, extendedArgs);
1893   return {};
1894 }
1895 
1896 template <typename GeneratorType>
1897 mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
1898                                                 llvm::StringRef name,
1899                                                 mlir::FunctionType funcType,
1900                                                 bool loadRefArguments) {
1901   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
1902   mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
1903   if (!function) {
1904     // First time this wrapper is needed, build it.
1905     function = builder.createFunction(loc, wrapperName, funcType);
1906     function->setAttr("fir.intrinsic", builder.getUnitAttr());
1907     auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
1908     auto linkage =
1909         mlir::LLVM::LinkageAttr::get(builder.getContext(), internalLinkage);
1910     function->setAttr("llvm.linkage", linkage);
1911     function.addEntryBlock();
1912 
1913     // Create local context to emit code into the newly created function
1914     // This new function is not linked to a source file location, only
1915     // its calls will be.
1916     auto localBuilder =
1917         std::make_unique<fir::FirOpBuilder>(function, builder.getKindMap());
1918     localBuilder->setInsertionPointToStart(&function.front());
1919     // Location of code inside wrapper of the wrapper is independent from
1920     // the location of the intrinsic call.
1921     mlir::Location localLoc = localBuilder->getUnknownLoc();
1922     llvm::SmallVector<mlir::Value> localArguments;
1923     for (mlir::BlockArgument bArg : function.front().getArguments()) {
1924       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
1925       if (loadRefArguments && refType) {
1926         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
1927         localArguments.push_back(loaded);
1928       } else {
1929         localArguments.push_back(bArg);
1930       }
1931     }
1932 
1933     IntrinsicLibrary localLib{*localBuilder, localLoc};
1934 
1935     if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
1936       localLib.invokeGenerator(generator, localArguments);
1937       localBuilder->create<mlir::func::ReturnOp>(localLoc);
1938     } else {
1939       assert(funcType.getNumResults() == 1 &&
1940              "expect one result for intrinsic function wrapper type");
1941       mlir::Type resultType = funcType.getResult(0);
1942       auto result =
1943           localLib.invokeGenerator(generator, resultType, localArguments);
1944       localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
1945     }
1946   } else {
1947     // Wrapper was already built, ensure it has the sought type
1948     assert(function.getFunctionType() == funcType &&
1949            "conflict between intrinsic wrapper types");
1950   }
1951   return function;
1952 }
1953 
1954 /// Helpers to detect absent optional (not yet supported in outlining).
1955 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
1956   for (const mlir::Value &arg : args)
1957     if (!arg)
1958       return true;
1959   return false;
1960 }
1961 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
1962   for (const fir::ExtendedValue &arg : args)
1963     if (!fir::getBase(arg))
1964       return true;
1965   return false;
1966 }
1967 
1968 template <typename GeneratorType>
1969 mlir::Value
1970 IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
1971                                    llvm::StringRef name, mlir::Type resultType,
1972                                    llvm::ArrayRef<mlir::Value> args) {
1973   if (hasAbsentOptional(args)) {
1974     // TODO: absent optional in outlining is an issue: we cannot just ignore
1975     // them. Needs a better interface here. The issue is that we cannot easily
1976     // tell that a value is optional or not here if it is presents. And if it is
1977     // absent, we cannot tell what it type should be.
1978     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1979                   " with absent optional argument");
1980   }
1981 
1982   mlir::FunctionType funcType = getFunctionType(resultType, args, builder);
1983   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
1984   return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0);
1985 }
1986 
1987 template <typename GeneratorType>
1988 fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
1989     GeneratorType generator, llvm::StringRef name,
1990     llvm::Optional<mlir::Type> resultType,
1991     llvm::ArrayRef<fir::ExtendedValue> args) {
1992   if (hasAbsentOptional(args))
1993     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1994                   " with absent optional argument");
1995   llvm::SmallVector<mlir::Value> mlirArgs;
1996   for (const auto &extendedVal : args)
1997     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
1998   mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
1999   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
2000   auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
2001   if (resultType)
2002     return toExtendedValue(call.getResult(0), builder, loc);
2003   // Subroutine calls
2004   return mlir::Value{};
2005 }
2006 
2007 IntrinsicLibrary::RuntimeCallGenerator
2008 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
2009                                           mlir::FunctionType soughtFuncType) {
2010   mlir::func::FuncOp funcOp;
2011   mlir::FunctionType actualFuncType;
2012   const MathOperation *mathOp = nullptr;
2013   if (!lowerEarlyToLibCall) {
2014     // Look for a dedicated math operation generator, which
2015     // normally produces a single MLIR operation implementing
2016     // the math operation.
2017     // If not found fall back to a runtime function lookup.
2018     const MathOperation *bestNearMatch = nullptr;
2019     FunctionDistance bestMatchDistance;
2020     mathOp = searchMathOperation(builder, name, soughtFuncType, &bestNearMatch,
2021                                  bestMatchDistance);
2022     if (!mathOp && bestNearMatch) {
2023       // Use the best near match, optionally issuing an error,
2024       // if types conversions cause precision loss.
2025       checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, loc);
2026       mathOp = bestNearMatch;
2027     }
2028     if (mathOp)
2029       actualFuncType = mathOp->typeGenerator(builder.getContext());
2030   }
2031   if (!mathOp)
2032     if ((funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType)))
2033       actualFuncType = funcOp.getFunctionType();
2034 
2035   if (!mathOp && !funcOp) {
2036     std::string nameAndType;
2037     llvm::raw_string_ostream sstream(nameAndType);
2038     sstream << name << "\nrequested type: " << soughtFuncType;
2039     crashOnMissingIntrinsic(loc, nameAndType);
2040   }
2041 
2042   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
2043          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
2044          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
2045 
2046   return [funcOp, actualFuncType, mathOp,
2047           soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
2048                           llvm::ArrayRef<mlir::Value> args) {
2049     llvm::SmallVector<mlir::Value> convertedArguments;
2050     for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
2051       convertedArguments.push_back(builder.createConvert(loc, fst, snd));
2052     mlir::Value result;
2053     // Use math operation generator, if available.
2054     if (mathOp)
2055       result = mathOp->funcGenerator(builder, loc, mathOp->runtimeFunc,
2056                                      actualFuncType, convertedArguments);
2057     else
2058       result = builder.create<fir::CallOp>(loc, funcOp, convertedArguments)
2059                    .getResult(0);
2060     mlir::Type soughtType = soughtFuncType.getResult(0);
2061     return builder.createConvert(loc, soughtType, result);
2062   };
2063 }
2064 
2065 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
2066     llvm::StringRef name, mlir::FunctionType signature) {
2067   // Unrestricted intrinsics signature follows implicit rules: argument
2068   // are passed by references. But the runtime versions expect values.
2069   // So instead of duplicating the runtime, just have the wrappers loading
2070   // this before calling the code generators.
2071   bool loadRefArguments = true;
2072   mlir::func::FuncOp funcOp;
2073   if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
2074     funcOp = std::visit(
2075         [&](auto generator) {
2076           return getWrapper(generator, name, signature, loadRefArguments);
2077         },
2078         handler->generator);
2079 
2080   if (!funcOp) {
2081     llvm::SmallVector<mlir::Type> argTypes;
2082     for (mlir::Type type : signature.getInputs()) {
2083       if (auto refType = type.dyn_cast<fir::ReferenceType>())
2084         argTypes.push_back(refType.getEleTy());
2085       else
2086         argTypes.push_back(type);
2087     }
2088     mlir::FunctionType soughtFuncType =
2089         builder.getFunctionType(argTypes, signature.getResults());
2090     IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
2091         getRuntimeCallGenerator(name, soughtFuncType);
2092     funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
2093   }
2094 
2095   return mlir::SymbolRefAttr::get(funcOp);
2096 }
2097 
2098 void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
2099   assert(stmtCtx);
2100   fir::FirOpBuilder *bldr = &builder;
2101   stmtCtx->attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
2102 }
2103 
2104 fir::ExtendedValue
2105 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
2106                                     mlir::Type resultType,
2107                                     llvm::StringRef intrinsicName) {
2108   fir::ExtendedValue res =
2109       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2110   return res.match(
2111       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2112         // Add cleanup code
2113         addCleanUpForTemp(loc, box.getAddr());
2114         return box;
2115       },
2116       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
2117         // Add cleanup code
2118         auto addr =
2119             builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
2120         addCleanUpForTemp(loc, addr);
2121         return box;
2122       },
2123       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
2124         // Add cleanup code
2125         addCleanUpForTemp(loc, box.getAddr());
2126         return box;
2127       },
2128       [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
2129         // Add cleanup code
2130         addCleanUpForTemp(loc, tempAddr);
2131         return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
2132       },
2133       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2134         // Add cleanup code
2135         addCleanUpForTemp(loc, box.getAddr());
2136         return box;
2137       },
2138       [&](const auto &) -> fir::ExtendedValue {
2139         fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
2140       });
2141 }
2142 
2143 //===----------------------------------------------------------------------===//
2144 // Code generators for the intrinsic
2145 //===----------------------------------------------------------------------===//
2146 
2147 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
2148                                              mlir::Type resultType,
2149                                              llvm::ArrayRef<mlir::Value> args) {
2150   mlir::FunctionType soughtFuncType =
2151       getFunctionType(resultType, args, builder);
2152   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
2153 }
2154 
2155 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
2156                                             llvm::ArrayRef<mlir::Value> args) {
2157   // There can be an optional kind in second argument.
2158   assert(args.size() >= 1);
2159   return builder.convertWithSemantics(loc, resultType, args[0]);
2160 }
2161 
2162 // ABS
2163 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
2164                                      llvm::ArrayRef<mlir::Value> args) {
2165   assert(args.size() == 1);
2166   mlir::Value arg = args[0];
2167   mlir::Type type = arg.getType();
2168   if (fir::isa_real(type)) {
2169     // Runtime call to fp abs. An alternative would be to use mlir
2170     // math::AbsFOp but it does not support all fir floating point types.
2171     return genRuntimeCall("abs", resultType, args);
2172   }
2173   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
2174     // At the time of this implementation there is no abs op in mlir.
2175     // So, implement abs here without branching.
2176     mlir::Value shift =
2177         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
2178     auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
2179     auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
2180     return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
2181   }
2182   if (fir::isa_complex(type)) {
2183     // Use HYPOT to fulfill the no underflow/overflow requirement.
2184     auto parts = fir::factory::Complex{builder, loc}.extractParts(arg);
2185     llvm::SmallVector<mlir::Value> args = {parts.first, parts.second};
2186     return genRuntimeCall("hypot", resultType, args);
2187   }
2188   llvm_unreachable("unexpected type in ABS argument");
2189 }
2190 
2191 // ADJUSTL & ADJUSTR
2192 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
2193                               mlir::Value, mlir::Value)>
2194 fir::ExtendedValue
2195 IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
2196                                   llvm::ArrayRef<fir::ExtendedValue> args) {
2197   assert(args.size() == 1);
2198   mlir::Value string = builder.createBox(loc, args[0]);
2199   // Create a mutable fir.box to be passed to the runtime for the result.
2200   fir::MutableBoxValue resultMutableBox =
2201       fir::factory::createTempMutableBox(builder, loc, resultType);
2202   mlir::Value resultIrBox =
2203       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2204 
2205   // Call the runtime -- the runtime will allocate the result.
2206   CallRuntime(builder, loc, resultIrBox, string);
2207 
2208   // Read result from mutable fir.box and add it to the list of temps to be
2209   // finalized by the StatementContext.
2210   fir::ExtendedValue res =
2211       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2212   return res.match(
2213       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2214         addCleanUpForTemp(loc, fir::getBase(box));
2215         return box;
2216       },
2217       [&](const auto &) -> fir::ExtendedValue {
2218         fir::emitFatalError(loc, "result of ADJUSTL is not a scalar character");
2219       });
2220 }
2221 
2222 // AIMAG
2223 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
2224                                        llvm::ArrayRef<mlir::Value> args) {
2225   assert(args.size() == 1);
2226   return fir::factory::Complex{builder, loc}.extractComplexPart(
2227       args[0], /*isImagPart=*/true);
2228 }
2229 
2230 // AINT
2231 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
2232                                       llvm::ArrayRef<mlir::Value> args) {
2233   assert(args.size() >= 1 && args.size() <= 2);
2234   // Skip optional kind argument to search the runtime; it is already reflected
2235   // in result type.
2236   return genRuntimeCall("aint", resultType, {args[0]});
2237 }
2238 
2239 // ALL
2240 fir::ExtendedValue
2241 IntrinsicLibrary::genAll(mlir::Type resultType,
2242                          llvm::ArrayRef<fir::ExtendedValue> args) {
2243 
2244   assert(args.size() == 2);
2245   // Handle required mask argument
2246   mlir::Value mask = builder.createBox(loc, args[0]);
2247 
2248   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2249   int rank = maskArry.rank();
2250   assert(rank >= 1);
2251 
2252   // Handle optional dim argument
2253   bool absentDim = isStaticallyAbsent(args[1]);
2254   mlir::Value dim =
2255       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2256                 : fir::getBase(args[1]);
2257 
2258   if (rank == 1 || absentDim)
2259     return builder.createConvert(loc, resultType,
2260                                  fir::runtime::genAll(builder, loc, mask, dim));
2261 
2262   // else use the result descriptor AllDim() intrinsic
2263 
2264   // Create mutable fir.box to be passed to the runtime for the result.
2265 
2266   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2267   fir::MutableBoxValue resultMutableBox =
2268       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2269   mlir::Value resultIrBox =
2270       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2271 
2272   // Call runtime. The runtime is allocating the result.
2273   fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
2274   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2275       .match(
2276           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2277             addCleanUpForTemp(loc, box.getAddr());
2278             return box;
2279           },
2280           [&](const auto &) -> fir::ExtendedValue {
2281             fir::emitFatalError(loc, "Invalid result for ALL");
2282           });
2283 }
2284 
2285 // ALLOCATED
2286 fir::ExtendedValue
2287 IntrinsicLibrary::genAllocated(mlir::Type resultType,
2288                                llvm::ArrayRef<fir::ExtendedValue> args) {
2289   assert(args.size() == 1);
2290   return args[0].match(
2291       [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
2292         return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
2293       },
2294       [&](const auto &) -> fir::ExtendedValue {
2295         fir::emitFatalError(loc,
2296                             "allocated arg not lowered to MutableBoxValue");
2297       });
2298 }
2299 
2300 // ANINT
2301 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
2302                                        llvm::ArrayRef<mlir::Value> args) {
2303   assert(args.size() >= 1 && args.size() <= 2);
2304   // Skip optional kind argument to search the runtime; it is already reflected
2305   // in result type.
2306   return genRuntimeCall("anint", resultType, {args[0]});
2307 }
2308 
2309 // ANY
2310 fir::ExtendedValue
2311 IntrinsicLibrary::genAny(mlir::Type resultType,
2312                          llvm::ArrayRef<fir::ExtendedValue> args) {
2313 
2314   assert(args.size() == 2);
2315   // Handle required mask argument
2316   mlir::Value mask = builder.createBox(loc, args[0]);
2317 
2318   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2319   int rank = maskArry.rank();
2320   assert(rank >= 1);
2321 
2322   // Handle optional dim argument
2323   bool absentDim = isStaticallyAbsent(args[1]);
2324   mlir::Value dim =
2325       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2326                 : fir::getBase(args[1]);
2327 
2328   if (rank == 1 || absentDim)
2329     return builder.createConvert(loc, resultType,
2330                                  fir::runtime::genAny(builder, loc, mask, dim));
2331 
2332   // else use the result descriptor AnyDim() intrinsic
2333 
2334   // Create mutable fir.box to be passed to the runtime for the result.
2335 
2336   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2337   fir::MutableBoxValue resultMutableBox =
2338       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2339   mlir::Value resultIrBox =
2340       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2341 
2342   // Call runtime. The runtime is allocating the result.
2343   fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
2344   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2345       .match(
2346           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2347             addCleanUpForTemp(loc, box.getAddr());
2348             return box;
2349           },
2350           [&](const auto &) -> fir::ExtendedValue {
2351             fir::emitFatalError(loc, "Invalid result for ANY");
2352           });
2353 }
2354 
2355 // ASSOCIATED
2356 fir::ExtendedValue
2357 IntrinsicLibrary::genAssociated(mlir::Type resultType,
2358                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2359   assert(args.size() == 2);
2360   auto *pointer =
2361       args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
2362                     [&](const auto &) -> const fir::MutableBoxValue * {
2363                       fir::emitFatalError(loc, "pointer not a MutableBoxValue");
2364                     });
2365   const fir::ExtendedValue &target = args[1];
2366   if (isStaticallyAbsent(target))
2367     return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
2368 
2369   mlir::Value targetBox = builder.createBox(loc, target);
2370   if (fir::valueHasFirAttribute(fir::getBase(target),
2371                                 fir::getOptionalAttrName())) {
2372     // Subtle: contrary to other intrinsic optional arguments, disassociated
2373     // POINTER and unallocated ALLOCATABLE actual argument are not considered
2374     // absent here. This is because ASSOCIATED has special requirements for
2375     // TARGET actual arguments that are POINTERs. There is no precise
2376     // requirements for ALLOCATABLEs, but all existing Fortran compilers treat
2377     // them similarly to POINTERs. That is: unallocated TARGETs cause ASSOCIATED
2378     // to rerun false.  The runtime deals with the disassociated/unallocated
2379     // case. Simply ensures that TARGET that are OPTIONAL get conditionally
2380     // emboxed here to convey the optional aspect to the runtime.
2381     auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
2382                                                       fir::getBase(target));
2383     auto absentBox = builder.create<fir::AbsentOp>(loc, targetBox.getType());
2384     targetBox = builder.create<mlir::arith::SelectOp>(loc, isPresent, targetBox,
2385                                                       absentBox);
2386   }
2387   mlir::Value pointerBoxRef =
2388       fir::factory::getMutableIRBox(builder, loc, *pointer);
2389   auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
2390   return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
2391 }
2392 
2393 // BGE, BGT, BLE, BLT
2394 template <mlir::arith::CmpIPredicate pred>
2395 mlir::Value
2396 IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
2397                                     llvm::ArrayRef<mlir::Value> args) {
2398   assert(args.size() == 2);
2399 
2400   mlir::Value arg0 = args[0];
2401   mlir::Value arg1 = args[1];
2402   mlir::Type arg0Ty = arg0.getType();
2403   mlir::Type arg1Ty = arg1.getType();
2404   unsigned bits0 = arg0Ty.getIntOrFloatBitWidth();
2405   unsigned bits1 = arg1Ty.getIntOrFloatBitWidth();
2406 
2407   // Arguments do not have to be of the same integer type. However, if neither
2408   // of the arguments is a BOZ literal, then the shorter of the two needs
2409   // to be converted to the longer by zero-extending (not sign-extending)
2410   // to the left [Fortran 2008, 13.3.2].
2411   //
2412   // In the case of BOZ literals, the standard describes zero-extension or
2413   // truncation depending on the kind of the result [Fortran 2008, 13.3.3].
2414   // However, that seems to be relevant for the case where the type of the
2415   // result must match the type of the BOZ literal. That is not the case for
2416   // these intrinsics, so, again, zero-extend to the larger type.
2417   //
2418   if (bits0 > bits1)
2419     arg1 = builder.create<mlir::arith::ExtUIOp>(loc, arg0Ty, arg1);
2420   else if (bits0 < bits1)
2421     arg0 = builder.create<mlir::arith::ExtUIOp>(loc, arg1Ty, arg0);
2422 
2423   return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
2424 }
2425 
2426 // BTEST
2427 mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
2428                                        llvm::ArrayRef<mlir::Value> args) {
2429   // A conformant BTEST(I,POS) call satisfies:
2430   //     POS >= 0
2431   //     POS < BIT_SIZE(I)
2432   // Return:  (I >> POS) & 1
2433   assert(args.size() == 2);
2434   mlir::Type argType = args[0].getType();
2435   mlir::Value pos = builder.createConvert(loc, argType, args[1]);
2436   auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
2437   mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
2438   auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
2439   return builder.createConvert(loc, resultType, res);
2440 }
2441 
2442 // CEILING
2443 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
2444                                          llvm::ArrayRef<mlir::Value> args) {
2445   // Optional KIND argument.
2446   assert(args.size() >= 1);
2447   mlir::Value arg = args[0];
2448   // Use ceil that is not an actual Fortran intrinsic but that is
2449   // an llvm intrinsic that does the same, but return a floating
2450   // point.
2451   mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
2452   return builder.createConvert(loc, resultType, ceil);
2453 }
2454 
2455 // CHAR
2456 fir::ExtendedValue
2457 IntrinsicLibrary::genChar(mlir::Type type,
2458                           llvm::ArrayRef<fir::ExtendedValue> args) {
2459   // Optional KIND argument.
2460   assert(args.size() >= 1);
2461   const mlir::Value *arg = args[0].getUnboxed();
2462   // expect argument to be a scalar integer
2463   if (!arg)
2464     mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
2465   fir::factory::CharacterExprHelper helper{builder, loc};
2466   fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
2467   mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
2468   mlir::Value len =
2469       builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
2470   return fir::CharBoxValue{cast, len};
2471 }
2472 
2473 // CMPLX
2474 mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
2475                                        llvm::ArrayRef<mlir::Value> args) {
2476   assert(args.size() >= 1);
2477   fir::factory::Complex complexHelper(builder, loc);
2478   mlir::Type partType = complexHelper.getComplexPartType(resultType);
2479   mlir::Value real = builder.createConvert(loc, partType, args[0]);
2480   mlir::Value imag = isStaticallyAbsent(args, 1)
2481                          ? builder.createRealZeroConstant(loc, partType)
2482                          : builder.createConvert(loc, partType, args[1]);
2483   return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
2484                                                            imag);
2485 }
2486 
2487 // COMMAND_ARGUMENT_COUNT
2488 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
2489     mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2490   assert(args.size() == 0);
2491   assert(resultType == builder.getDefaultIntegerType() &&
2492          "result type is not default integer kind type");
2493   return builder.createConvert(
2494       loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
2495   ;
2496 }
2497 
2498 // CONJG
2499 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
2500                                        llvm::ArrayRef<mlir::Value> args) {
2501   assert(args.size() == 1);
2502   if (resultType != args[0].getType())
2503     llvm_unreachable("argument type mismatch");
2504 
2505   mlir::Value cplx = args[0];
2506   auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
2507       cplx, /*isImagPart=*/true);
2508   auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
2509   return fir::factory::Complex{builder, loc}.insertComplexPart(
2510       cplx, negImag, /*isImagPart=*/true);
2511 }
2512 
2513 // COUNT
2514 fir::ExtendedValue
2515 IntrinsicLibrary::genCount(mlir::Type resultType,
2516                            llvm::ArrayRef<fir::ExtendedValue> args) {
2517   assert(args.size() == 3);
2518 
2519   // Handle mask argument
2520   fir::BoxValue mask = builder.createBox(loc, args[0]);
2521   unsigned maskRank = mask.rank();
2522 
2523   assert(maskRank > 0);
2524 
2525   // Handle optional dim argument
2526   bool absentDim = isStaticallyAbsent(args[1]);
2527   mlir::Value dim =
2528       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
2529                 : fir::getBase(args[1]);
2530 
2531   if (absentDim || maskRank == 1) {
2532     // Result is scalar if no dim argument or mask is rank 1.
2533     // So, call specialized Count runtime routine.
2534     return builder.createConvert(
2535         loc, resultType,
2536         fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
2537   }
2538 
2539   // Call general CountDim runtime routine.
2540 
2541   // Handle optional kind argument
2542   bool absentKind = isStaticallyAbsent(args[2]);
2543   mlir::Value kind = absentKind ? builder.createIntegerConstant(
2544                                       loc, builder.getIndexType(),
2545                                       builder.getKindMap().defaultIntegerKind())
2546                                 : fir::getBase(args[2]);
2547 
2548   // Create mutable fir.box to be passed to the runtime for the result.
2549   mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
2550   fir::MutableBoxValue resultMutableBox =
2551       fir::factory::createTempMutableBox(builder, loc, type);
2552 
2553   mlir::Value resultIrBox =
2554       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2555 
2556   fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
2557                             kind);
2558 
2559   // Handle cleanup of allocatable result descriptor and return
2560   fir::ExtendedValue res =
2561       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2562   return res.match(
2563       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2564         // Add cleanup code
2565         addCleanUpForTemp(loc, box.getAddr());
2566         return box;
2567       },
2568       [&](const auto &) -> fir::ExtendedValue {
2569         fir::emitFatalError(loc, "unexpected result for COUNT");
2570       });
2571 }
2572 
2573 // CPU_TIME
2574 void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2575   assert(args.size() == 1);
2576   const mlir::Value *arg = args[0].getUnboxed();
2577   assert(arg && "nonscalar cpu_time argument");
2578   mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
2579   mlir::Value res2 =
2580       builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
2581   builder.create<fir::StoreOp>(loc, res2, *arg);
2582 }
2583 
2584 // CSHIFT
2585 fir::ExtendedValue
2586 IntrinsicLibrary::genCshift(mlir::Type resultType,
2587                             llvm::ArrayRef<fir::ExtendedValue> args) {
2588   assert(args.size() == 3);
2589 
2590   // Handle required ARRAY argument
2591   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2592   mlir::Value array = fir::getBase(arrayBox);
2593   unsigned arrayRank = arrayBox.rank();
2594 
2595   // Create mutable fir.box to be passed to the runtime for the result.
2596   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2597   fir::MutableBoxValue resultMutableBox =
2598       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2599   mlir::Value resultIrBox =
2600       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2601 
2602   if (arrayRank == 1) {
2603     // Vector case
2604     // Handle required SHIFT argument as a scalar
2605     const mlir::Value *shiftAddr = args[1].getUnboxed();
2606     assert(shiftAddr && "nonscalar CSHIFT argument");
2607     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2608 
2609     fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
2610   } else {
2611     // Non-vector case
2612     // Handle required SHIFT argument as an array
2613     mlir::Value shift = builder.createBox(loc, args[1]);
2614 
2615     // Handle optional DIM argument
2616     mlir::Value dim =
2617         isStaticallyAbsent(args[2])
2618             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2619             : fir::getBase(args[2]);
2620     fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
2621   }
2622   return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
2623 }
2624 
2625 // DATE_AND_TIME
2626 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2627   assert(args.size() == 4 && "date_and_time has 4 args");
2628   llvm::SmallVector<llvm::Optional<fir::CharBoxValue>> charArgs(3);
2629   for (unsigned i = 0; i < 3; ++i)
2630     if (const fir::CharBoxValue *charBox = args[i].getCharBox())
2631       charArgs[i] = *charBox;
2632 
2633   mlir::Value values = fir::getBase(args[3]);
2634   if (!values)
2635     values = builder.create<fir::AbsentOp>(
2636         loc, fir::BoxType::get(builder.getNoneType()));
2637 
2638   Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
2639                                  charArgs[2], values);
2640 }
2641 
2642 // DIM
2643 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
2644                                      llvm::ArrayRef<mlir::Value> args) {
2645   assert(args.size() == 2);
2646   if (resultType.isa<mlir::IntegerType>()) {
2647     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2648     auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
2649     auto cmp = builder.create<mlir::arith::CmpIOp>(
2650         loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
2651     return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2652   }
2653   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
2654   mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
2655   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
2656   auto cmp = builder.create<mlir::arith::CmpFOp>(
2657       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
2658   return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2659 }
2660 
2661 // DOT_PRODUCT
2662 fir::ExtendedValue
2663 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
2664                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2665   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
2666                     stmtCtx, args);
2667 }
2668 
2669 // DPROD
2670 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
2671                                        llvm::ArrayRef<mlir::Value> args) {
2672   assert(args.size() == 2);
2673   assert(fir::isa_real(resultType) &&
2674          "Result must be double precision in DPROD");
2675   mlir::Value a = builder.createConvert(loc, resultType, args[0]);
2676   mlir::Value b = builder.createConvert(loc, resultType, args[1]);
2677   return builder.create<mlir::arith::MulFOp>(loc, a, b);
2678 }
2679 
2680 // DSHIFTL
2681 mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
2682                                          llvm::ArrayRef<mlir::Value> args) {
2683   assert(args.size() == 3);
2684 
2685   mlir::Value i = args[0];
2686   mlir::Value j = args[1];
2687   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2688   mlir::Value bitSize = builder.createIntegerConstant(
2689       loc, resultType, resultType.getIntOrFloatBitWidth());
2690 
2691   // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
2692   // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
2693   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2694 
2695   mlir::Value lArgs[2]{i, shift};
2696   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2697 
2698   mlir::Value rArgs[2]{j, diff};
2699   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2700 
2701   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2702 }
2703 
2704 // DSHIFTR
2705 mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
2706                                          llvm::ArrayRef<mlir::Value> args) {
2707   assert(args.size() == 3);
2708 
2709   mlir::Value i = args[0];
2710   mlir::Value j = args[1];
2711   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2712   mlir::Value bitSize = builder.createIntegerConstant(
2713       loc, resultType, resultType.getIntOrFloatBitWidth());
2714 
2715   // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
2716   // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
2717   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2718 
2719   mlir::Value lArgs[2]{i, diff};
2720   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2721 
2722   mlir::Value rArgs[2]{j, shift};
2723   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2724 
2725   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2726 }
2727 
2728 // EOSHIFT
2729 fir::ExtendedValue
2730 IntrinsicLibrary::genEoshift(mlir::Type resultType,
2731                              llvm::ArrayRef<fir::ExtendedValue> args) {
2732   assert(args.size() == 4);
2733 
2734   // Handle required ARRAY argument
2735   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2736   mlir::Value array = fir::getBase(arrayBox);
2737   unsigned arrayRank = arrayBox.rank();
2738 
2739   // Create mutable fir.box to be passed to the runtime for the result.
2740   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2741   fir::MutableBoxValue resultMutableBox =
2742       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2743   mlir::Value resultIrBox =
2744       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2745 
2746   // Handle optional BOUNDARY argument
2747   mlir::Value boundary =
2748       isStaticallyAbsent(args[2])
2749           ? builder.create<fir::AbsentOp>(
2750                 loc, fir::BoxType::get(builder.getNoneType()))
2751           : builder.createBox(loc, args[2]);
2752 
2753   if (arrayRank == 1) {
2754     // Vector case
2755     // Handle required SHIFT argument as a scalar
2756     const mlir::Value *shiftAddr = args[1].getUnboxed();
2757     assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
2758     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2759     fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
2760                                    boundary);
2761   } else {
2762     // Non-vector case
2763     // Handle required SHIFT argument as an array
2764     mlir::Value shift = builder.createBox(loc, args[1]);
2765 
2766     // Handle optional DIM argument
2767     mlir::Value dim =
2768         isStaticallyAbsent(args[3])
2769             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2770             : fir::getBase(args[3]);
2771     fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
2772                              dim);
2773   }
2774   return readAndAddCleanUp(resultMutableBox, resultType,
2775                            "unexpected result for EOSHIFT");
2776 }
2777 
2778 // EXIT
2779 void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
2780   assert(args.size() == 1);
2781 
2782   mlir::Value status =
2783       isStaticallyAbsent(args[0])
2784           ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
2785                                           EXIT_SUCCESS)
2786           : fir::getBase(args[0]);
2787 
2788   assert(status.getType() == builder.getDefaultIntegerType() &&
2789          "STATUS parameter must be an INTEGER of default kind");
2790 
2791   fir::runtime::genExit(builder, loc, status);
2792 }
2793 
2794 // EXPONENT
2795 mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
2796                                           llvm::ArrayRef<mlir::Value> args) {
2797   assert(args.size() == 1);
2798 
2799   return builder.createConvert(
2800       loc, resultType,
2801       fir::runtime::genExponent(builder, loc, resultType,
2802                                 fir::getBase(args[0])));
2803 }
2804 
2805 // FLOOR
2806 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
2807                                        llvm::ArrayRef<mlir::Value> args) {
2808   // Optional KIND argument.
2809   assert(args.size() >= 1);
2810   mlir::Value arg = args[0];
2811   // Use LLVM floor that returns real.
2812   mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
2813   return builder.createConvert(loc, resultType, floor);
2814 }
2815 
2816 // FRACTION
2817 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
2818                                           llvm::ArrayRef<mlir::Value> args) {
2819   assert(args.size() == 1);
2820 
2821   return builder.createConvert(
2822       loc, resultType,
2823       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
2824 }
2825 
2826 // GET_COMMAND_ARGUMENT
2827 void IntrinsicLibrary::genGetCommandArgument(
2828     llvm::ArrayRef<fir::ExtendedValue> args) {
2829   assert(args.size() == 5);
2830   mlir::Value number = fir::getBase(args[0]);
2831   const fir::ExtendedValue &value = args[1];
2832   const fir::ExtendedValue &length = args[2];
2833   const fir::ExtendedValue &status = args[3];
2834   const fir::ExtendedValue &errmsg = args[4];
2835 
2836   if (!number)
2837     fir::emitFatalError(loc, "expected NUMBER parameter");
2838 
2839   if (isStaticallyPresent(value) || isStaticallyPresent(status) ||
2840       isStaticallyPresent(errmsg)) {
2841     mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
2842     mlir::Value valBox =
2843         isStaticallyPresent(value)
2844             ? fir::getBase(value)
2845             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2846     mlir::Value errBox =
2847         isStaticallyPresent(errmsg)
2848             ? fir::getBase(errmsg)
2849             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2850     mlir::Value stat =
2851         fir::runtime::genArgumentValue(builder, loc, number, valBox, errBox);
2852     if (isStaticallyPresent(status)) {
2853       mlir::Value statAddr = fir::getBase(status);
2854       mlir::Value statIsPresentAtRuntime =
2855           builder.genIsNotNullAddr(loc, statAddr);
2856       builder.genIfThen(loc, statIsPresentAtRuntime)
2857           .genThen(
2858               [&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
2859           .end();
2860     }
2861   }
2862   if (isStaticallyPresent(length)) {
2863     mlir::Value lenAddr = fir::getBase(length);
2864     mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr);
2865     builder.genIfThen(loc, lenIsPresentAtRuntime)
2866         .genThen([&]() {
2867           mlir::Value len =
2868               fir::runtime::genArgumentLength(builder, loc, number);
2869           builder.createStoreWithConvert(loc, len, lenAddr);
2870         })
2871         .end();
2872   }
2873 }
2874 
2875 // GET_ENVIRONMENT_VARIABLE
2876 void IntrinsicLibrary::genGetEnvironmentVariable(
2877     llvm::ArrayRef<fir::ExtendedValue> args) {
2878   assert(args.size() == 6);
2879   mlir::Value name = fir::getBase(args[0]);
2880   const fir::ExtendedValue &value = args[1];
2881   const fir::ExtendedValue &length = args[2];
2882   const fir::ExtendedValue &status = args[3];
2883   const fir::ExtendedValue &trimName = args[4];
2884   const fir::ExtendedValue &errmsg = args[5];
2885 
2886   // Handle optional TRIM_NAME argument
2887   mlir::Value trim;
2888   if (isStaticallyAbsent(trimName)) {
2889     trim = builder.createBool(loc, true);
2890   } else {
2891     mlir::Type i1Ty = builder.getI1Type();
2892     mlir::Value trimNameAddr = fir::getBase(trimName);
2893     mlir::Value trimNameIsPresentAtRuntime =
2894         builder.genIsNotNullAddr(loc, trimNameAddr);
2895     trim = builder
2896                .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,
2897                         /*withElseRegion=*/true)
2898                .genThen([&]() {
2899                  auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr);
2900                  mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);
2901                  builder.create<fir::ResultOp>(loc, cast);
2902                })
2903                .genElse([&]() {
2904                  mlir::Value trueVal = builder.createBool(loc, true);
2905                  builder.create<fir::ResultOp>(loc, trueVal);
2906                })
2907                .getResults()[0];
2908   }
2909 
2910   if (isStaticallyPresent(value) || isStaticallyPresent(status) ||
2911       isStaticallyPresent(errmsg)) {
2912     mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
2913     mlir::Value valBox =
2914         isStaticallyPresent(value)
2915             ? fir::getBase(value)
2916             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2917     mlir::Value errBox =
2918         isStaticallyPresent(errmsg)
2919             ? fir::getBase(errmsg)
2920             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2921     mlir::Value stat = fir::runtime::genEnvVariableValue(builder, loc, name,
2922                                                          valBox, trim, errBox);
2923     if (isStaticallyPresent(status)) {
2924       mlir::Value statAddr = fir::getBase(status);
2925       mlir::Value statIsPresentAtRuntime =
2926           builder.genIsNotNullAddr(loc, statAddr);
2927       builder.genIfThen(loc, statIsPresentAtRuntime)
2928           .genThen(
2929               [&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
2930           .end();
2931     }
2932   }
2933 
2934   if (isStaticallyPresent(length)) {
2935     mlir::Value lenAddr = fir::getBase(length);
2936     mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr);
2937     builder.genIfThen(loc, lenIsPresentAtRuntime)
2938         .genThen([&]() {
2939           mlir::Value len =
2940               fir::runtime::genEnvVariableLength(builder, loc, name, trim);
2941           builder.createStoreWithConvert(loc, len, lenAddr);
2942         })
2943         .end();
2944   }
2945 }
2946 
2947 // IAND
2948 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
2949                                       llvm::ArrayRef<mlir::Value> args) {
2950   assert(args.size() == 2);
2951   auto arg0 = builder.createConvert(loc, resultType, args[0]);
2952   auto arg1 = builder.createConvert(loc, resultType, args[1]);
2953   return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
2954 }
2955 
2956 // IBCLR
2957 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
2958                                        llvm::ArrayRef<mlir::Value> args) {
2959   // A conformant IBCLR(I,POS) call satisfies:
2960   //     POS >= 0
2961   //     POS < BIT_SIZE(I)
2962   // Return:  I & (!(1 << POS))
2963   assert(args.size() == 2);
2964   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2965   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
2966   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2967   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
2968   auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
2969   return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
2970 }
2971 
2972 // IBITS
2973 mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
2974                                        llvm::ArrayRef<mlir::Value> args) {
2975   // A conformant IBITS(I,POS,LEN) call satisfies:
2976   //     POS >= 0
2977   //     LEN >= 0
2978   //     POS + LEN <= BIT_SIZE(I)
2979   // Return:  LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
2980   // For a conformant call, implementing (I >> POS) with a signed or an
2981   // unsigned shift produces the same result.  For a nonconformant call,
2982   // the two choices may produce different results.
2983   assert(args.size() == 3);
2984   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2985   mlir::Value len = builder.createConvert(loc, resultType, args[2]);
2986   mlir::Value bitSize = builder.createIntegerConstant(
2987       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
2988   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
2989   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2990   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2991   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
2992   auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
2993   auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
2994   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
2995       loc, mlir::arith::CmpIPredicate::eq, len, zero);
2996   return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
2997 }
2998 
2999 // IBSET
3000 mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
3001                                        llvm::ArrayRef<mlir::Value> args) {
3002   // A conformant IBSET(I,POS) call satisfies:
3003   //     POS >= 0
3004   //     POS < BIT_SIZE(I)
3005   // Return:  I | (1 << POS)
3006   assert(args.size() == 2);
3007   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3008   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3009   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
3010   return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
3011 }
3012 
3013 // ICHAR
3014 fir::ExtendedValue
3015 IntrinsicLibrary::genIchar(mlir::Type resultType,
3016                            llvm::ArrayRef<fir::ExtendedValue> args) {
3017   // There can be an optional kind in second argument.
3018   assert(args.size() == 2);
3019   const fir::CharBoxValue *charBox = args[0].getCharBox();
3020   if (!charBox)
3021     llvm::report_fatal_error("expected character scalar");
3022 
3023   fir::factory::CharacterExprHelper helper{builder, loc};
3024   mlir::Value buffer = charBox->getBuffer();
3025   mlir::Type bufferTy = buffer.getType();
3026   mlir::Value charVal;
3027   if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
3028     assert(charTy.singleton());
3029     charVal = buffer;
3030   } else {
3031     // Character is in memory, cast to fir.ref<char> and load.
3032     mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
3033     if (!ty)
3034       llvm::report_fatal_error("expected memory type");
3035     // The length of in the character type may be unknown. Casting
3036     // to a singleton ref is required before loading.
3037     fir::CharacterType eleType = helper.getCharacterType(ty);
3038     fir::CharacterType charType =
3039         fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
3040     mlir::Type toTy = builder.getRefType(charType);
3041     mlir::Value cast = builder.createConvert(loc, toTy, buffer);
3042     charVal = builder.create<fir::LoadOp>(loc, cast);
3043   }
3044   LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
3045   auto code = helper.extractCodeFromSingleton(charVal);
3046   if (code.getType() == resultType)
3047     return code;
3048   return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
3049 }
3050 
3051 // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
3052 // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
3053 template <mlir::arith::CmpIPredicate pred>
3054 fir::ExtendedValue
3055 IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
3056                                      llvm::ArrayRef<fir::ExtendedValue> args) {
3057   assert(args.size() == 2);
3058   mlir::Value arg0 = fir::getBase(args[0]);
3059   mlir::Value arg1 = fir::getBase(args[1]);
3060   auto recType =
3061       fir::unwrapPassByRefType(arg0.getType()).dyn_cast<fir::RecordType>();
3062   assert(recType.getTypeList().size() == 1 && "expected exactly one component");
3063   auto [fieldName, fieldType] = recType.getTypeList().front();
3064   mlir::Type fieldIndexType = fir::FieldType::get(recType.getContext());
3065   mlir::Value field = builder.create<fir::FieldIndexOp>(
3066       loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0));
3067   mlir::Value left = builder.create<fir::LoadOp>(
3068       loc, fieldType,
3069       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
3070                                         arg0, field));
3071   mlir::Value right = builder.create<fir::LoadOp>(
3072       loc, fieldType,
3073       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
3074                                         arg1, field));
3075   return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
3076 }
3077 
3078 // IEEE_IS_FINITE
3079 mlir::Value
3080 IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
3081                                   llvm::ArrayRef<mlir::Value> args) {
3082   // IEEE_IS_FINITE(X) is true iff exponent(X) is the max exponent of kind(X).
3083   assert(args.size() == 1);
3084   mlir::Value floatVal = fir::getBase(args[0]);
3085   mlir::FloatType floatType = floatVal.getType().dyn_cast<mlir::FloatType>();
3086   int floatBits = floatType.getWidth();
3087   mlir::Type intType = builder.getIntegerType(
3088       floatType.isa<mlir::Float80Type>() ? 128 : floatBits);
3089   mlir::Value intVal =
3090       builder.create<mlir::arith::BitcastOp>(loc, intType, floatVal);
3091   int significandBits;
3092   if (floatType.isa<mlir::Float32Type>())
3093     significandBits = 23;
3094   else if (floatType.isa<mlir::Float64Type>())
3095     significandBits = 52;
3096   else // problems elsewhere for other kinds
3097     TODO(loc, "intrinsic module procedure: ieee_is_finite");
3098   mlir::Value significand =
3099       builder.createIntegerConstant(loc, intType, significandBits);
3100   int exponentBits = floatBits - 1 - significandBits;
3101   mlir::Value maxExponent =
3102       builder.createIntegerConstant(loc, intType, (1 << exponentBits) - 1);
3103   mlir::Value exponent = genIbits(
3104       intType, {intVal, significand,
3105                 builder.createIntegerConstant(loc, intType, exponentBits)});
3106   return builder.createConvert(
3107       loc, resultType,
3108       builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
3109                                           exponent, maxExponent));
3110 }
3111 
3112 // IEOR
3113 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
3114                                       llvm::ArrayRef<mlir::Value> args) {
3115   assert(args.size() == 2);
3116   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3117 }
3118 
3119 // INDEX
3120 fir::ExtendedValue
3121 IntrinsicLibrary::genIndex(mlir::Type resultType,
3122                            llvm::ArrayRef<fir::ExtendedValue> args) {
3123   assert(args.size() >= 2 && args.size() <= 4);
3124 
3125   mlir::Value stringBase = fir::getBase(args[0]);
3126   fir::KindTy kind =
3127       fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3128           stringBase.getType());
3129   mlir::Value stringLen = fir::getLen(args[0]);
3130   mlir::Value substringBase = fir::getBase(args[1]);
3131   mlir::Value substringLen = fir::getLen(args[1]);
3132   mlir::Value back =
3133       isStaticallyAbsent(args, 2)
3134           ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3135           : fir::getBase(args[2]);
3136   if (isStaticallyAbsent(args, 3))
3137     return builder.createConvert(
3138         loc, resultType,
3139         fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
3140                                substringBase, substringLen, back));
3141 
3142   // Call the descriptor-based Index implementation
3143   mlir::Value string = builder.createBox(loc, args[0]);
3144   mlir::Value substring = builder.createBox(loc, args[1]);
3145   auto makeRefThenEmbox = [&](mlir::Value b) {
3146     fir::LogicalType logTy = fir::LogicalType::get(
3147         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3148     mlir::Value temp = builder.createTemporary(loc, logTy);
3149     mlir::Value castb = builder.createConvert(loc, logTy, b);
3150     builder.create<fir::StoreOp>(loc, castb, temp);
3151     return builder.createBox(loc, temp);
3152   };
3153   mlir::Value backOpt = isStaticallyAbsent(args, 2)
3154                             ? builder.create<fir::AbsentOp>(
3155                                   loc, fir::BoxType::get(builder.getI1Type()))
3156                             : makeRefThenEmbox(fir::getBase(args[2]));
3157   mlir::Value kindVal = isStaticallyAbsent(args, 3)
3158                             ? builder.createIntegerConstant(
3159                                   loc, builder.getIndexType(),
3160                                   builder.getKindMap().defaultIntegerKind())
3161                             : fir::getBase(args[3]);
3162   // Create mutable fir.box to be passed to the runtime for the result.
3163   fir::MutableBoxValue mutBox =
3164       fir::factory::createTempMutableBox(builder, loc, resultType);
3165   mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
3166   // Call runtime. The runtime is allocating the result.
3167   fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
3168                                    backOpt, kindVal);
3169   // Read back the result from the mutable box.
3170   return readAndAddCleanUp(mutBox, resultType, "INDEX");
3171 }
3172 
3173 // IOR
3174 mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
3175                                      llvm::ArrayRef<mlir::Value> args) {
3176   assert(args.size() == 2);
3177   return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
3178 }
3179 
3180 // ISHFT
3181 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
3182                                        llvm::ArrayRef<mlir::Value> args) {
3183   // A conformant ISHFT(I,SHIFT) call satisfies:
3184   //     abs(SHIFT) <= BIT_SIZE(I)
3185   // Return:  abs(SHIFT) >= BIT_SIZE(I)
3186   //              ? 0
3187   //              : SHIFT < 0
3188   //                    ? I >> abs(SHIFT)
3189   //                    : I << abs(SHIFT)
3190   assert(args.size() == 2);
3191   mlir::Value bitSize = builder.createIntegerConstant(
3192       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3193   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3194   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3195   mlir::Value absShift = genAbs(resultType, {shift});
3196   auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
3197   auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
3198   auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
3199       loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
3200   auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
3201       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
3202   auto sel =
3203       builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
3204   return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
3205 }
3206 
3207 // ISHFTC
3208 mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
3209                                         llvm::ArrayRef<mlir::Value> args) {
3210   // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
3211   //     SIZE > 0
3212   //     SIZE <= BIT_SIZE(I)
3213   //     abs(SHIFT) <= SIZE
3214   // if SHIFT > 0
3215   //     leftSize = abs(SHIFT)
3216   //     rightSize = SIZE - abs(SHIFT)
3217   // else [if SHIFT < 0]
3218   //     leftSize = SIZE - abs(SHIFT)
3219   //     rightSize = abs(SHIFT)
3220   // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
3221   // leftMaskShift = BIT_SIZE(I) - leftSize
3222   // rightMaskShift = BIT_SIZE(I) - rightSize
3223   // left = (I >> rightSize) & (-1 >> leftMaskShift)
3224   // right = (I & (-1 >> rightMaskShift)) << leftSize
3225   // Return:  SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
3226   assert(args.size() == 3);
3227   mlir::Value bitSize = builder.createIntegerConstant(
3228       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3229   mlir::Value I = args[0];
3230   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3231   mlir::Value size =
3232       args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
3233   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3234   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3235   mlir::Value absShift = genAbs(resultType, {shift});
3236   auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
3237   auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
3238       loc, mlir::arith::CmpIPredicate::eq, shift, zero);
3239   auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
3240       loc, mlir::arith::CmpIPredicate::eq, absShift, size);
3241   auto shiftIsNop =
3242       builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
3243   auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
3244       loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
3245   auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3246                                                         absShift, elseSize);
3247   auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3248                                                          elseSize, absShift);
3249   auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
3250       loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
3251   auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
3252   auto unchangedTmp2 =
3253       builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
3254   auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
3255                                                          unchangedTmp2, zero);
3256   auto leftMaskShift =
3257       builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
3258   auto leftMask =
3259       builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
3260   auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
3261   auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
3262   auto rightMaskShift =
3263       builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
3264   auto rightMask =
3265       builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
3266   auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
3267   auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
3268   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
3269   auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
3270   return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
3271 }
3272 
3273 // LEADZ
3274 mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,
3275                                        llvm::ArrayRef<mlir::Value> args) {
3276   assert(args.size() == 1);
3277 
3278   mlir::Value result =
3279       builder.create<mlir::math::CountLeadingZerosOp>(loc, args);
3280 
3281   return builder.createConvert(loc, resultType, result);
3282 }
3283 
3284 // LEN
3285 // Note that this is only used for an unrestricted intrinsic LEN call.
3286 // Other uses of LEN are rewritten as descriptor inquiries by the front-end.
3287 fir::ExtendedValue
3288 IntrinsicLibrary::genLen(mlir::Type resultType,
3289                          llvm::ArrayRef<fir::ExtendedValue> args) {
3290   // Optional KIND argument reflected in result type and otherwise ignored.
3291   assert(args.size() == 1 || args.size() == 2);
3292   mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
3293   return builder.createConvert(loc, resultType, len);
3294 }
3295 
3296 // LEN_TRIM
3297 fir::ExtendedValue
3298 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
3299                              llvm::ArrayRef<fir::ExtendedValue> args) {
3300   // Optional KIND argument reflected in result type and otherwise ignored.
3301   assert(args.size() == 1 || args.size() == 2);
3302   const fir::CharBoxValue *charBox = args[0].getCharBox();
3303   if (!charBox)
3304     TODO(loc, "character array len_trim");
3305   auto len =
3306       fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
3307   return builder.createConvert(loc, resultType, len);
3308 }
3309 
3310 // LGE, LGT, LLE, LLT
3311 template <mlir::arith::CmpIPredicate pred>
3312 fir::ExtendedValue
3313 IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
3314                                       llvm::ArrayRef<fir::ExtendedValue> args) {
3315   assert(args.size() == 2);
3316   return fir::runtime::genCharCompare(
3317       builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
3318       fir::getBase(args[1]), fir::getLen(args[1]));
3319 }
3320 
3321 // MASKL, MASKR
3322 template <typename Shift>
3323 mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
3324                                       llvm::ArrayRef<mlir::Value> args) {
3325   assert(args.size() == 2);
3326 
3327   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3328   mlir::Value bitSize = builder.createIntegerConstant(
3329       loc, resultType, resultType.getIntOrFloatBitWidth());
3330   mlir::Value bitsToSet = builder.createConvert(loc, resultType, args[0]);
3331 
3332   // The standard does not specify what to return if the number of bits to be
3333   // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
3334   // produce a poison value which may return a possibly platform-specific and/or
3335   // non-deterministic result. Other compilers don't produce a consistent result
3336   // in this case either, so we choose the most efficient implementation.
3337   mlir::Value shift =
3338       builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet);
3339   return builder.create<Shift>(loc, ones, shift);
3340 }
3341 
3342 // MATMUL
3343 fir::ExtendedValue
3344 IntrinsicLibrary::genMatmul(mlir::Type resultType,
3345                             llvm::ArrayRef<fir::ExtendedValue> args) {
3346   assert(args.size() == 2);
3347 
3348   // Handle required matmul arguments
3349   fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
3350   mlir::Value matrixA = fir::getBase(matrixTmpA);
3351   fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
3352   mlir::Value matrixB = fir::getBase(matrixTmpB);
3353   unsigned resultRank =
3354       (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
3355 
3356   // Create mutable fir.box to be passed to the runtime for the result.
3357   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
3358   fir::MutableBoxValue resultMutableBox =
3359       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3360   mlir::Value resultIrBox =
3361       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3362   // Call runtime. The runtime is allocating the result.
3363   fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
3364   // Read result from mutable fir.box and add it to the list of temps to be
3365   // finalized by the StatementContext.
3366   return readAndAddCleanUp(resultMutableBox, resultType,
3367                            "unexpected result for MATMUL");
3368 }
3369 
3370 // MERGE
3371 fir::ExtendedValue
3372 IntrinsicLibrary::genMerge(mlir::Type,
3373                            llvm::ArrayRef<fir::ExtendedValue> args) {
3374   assert(args.size() == 3);
3375   mlir::Value tsource = fir::getBase(args[0]);
3376   mlir::Value fsource = fir::getBase(args[1]);
3377   mlir::Value rawMask = fir::getBase(args[2]);
3378   mlir::Type type0 = fir::unwrapRefType(tsource.getType());
3379   bool isCharRslt = fir::isa_char(type0); // result is same as first argument
3380   mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
3381   // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
3382   // types (one can have dynamic length while the other has constant lengths,
3383   // or one may be a fir.logical<> while the other is an i1). Insert a cast to
3384   // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
3385   mlir::Value fsourceCast =
3386       builder.createConvert(loc, tsource.getType(), fsource);
3387   auto rslt =
3388       builder.create<mlir::arith::SelectOp>(loc, mask, tsource, fsourceCast);
3389   if (isCharRslt) {
3390     // Need a CharBoxValue for character results
3391     const fir::CharBoxValue *charBox = args[0].getCharBox();
3392     fir::CharBoxValue charRslt(rslt, charBox->getLen());
3393     return charRslt;
3394   }
3395   return rslt;
3396 }
3397 
3398 // MERGE_BITS
3399 mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
3400                                            llvm::ArrayRef<mlir::Value> args) {
3401   assert(args.size() == 3);
3402 
3403   mlir::Value i = builder.createConvert(loc, resultType, args[0]);
3404   mlir::Value j = builder.createConvert(loc, resultType, args[1]);
3405   mlir::Value mask = builder.createConvert(loc, resultType, args[2]);
3406   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3407 
3408   // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
3409   mlir::Value notMask = builder.create<mlir::arith::XOrIOp>(loc, mask, ones);
3410   mlir::Value lft = builder.create<mlir::arith::AndIOp>(loc, i, mask);
3411   mlir::Value rgt = builder.create<mlir::arith::AndIOp>(loc, j, notMask);
3412 
3413   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3414 }
3415 
3416 // MOD
3417 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
3418                                      llvm::ArrayRef<mlir::Value> args) {
3419   assert(args.size() == 2);
3420   if (resultType.isa<mlir::IntegerType>())
3421     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3422 
3423   // Use runtime. Note that mlir::arith::RemFOp implements floating point
3424   // remainder, but it does not work with fir::Real type.
3425   // TODO: consider using mlir::arith::RemFOp when possible, that may help
3426   // folding and  optimizations.
3427   return genRuntimeCall("mod", resultType, args);
3428 }
3429 
3430 // MODULO
3431 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
3432                                         llvm::ArrayRef<mlir::Value> args) {
3433   assert(args.size() == 2);
3434   // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
3435   // In the meantime, use a simple inlined implementation based on truncated
3436   // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
3437   // division and multiplication from MODULO formula.
3438   //  - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
3439   //  - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
3440   //    A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
3441   // Note that A/P < 0 if and only if A and P signs are different.
3442   if (resultType.isa<mlir::IntegerType>()) {
3443     auto remainder =
3444         builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3445     auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3446     mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
3447     auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
3448         loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
3449     auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
3450         loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
3451     auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3452                                                         argSignDifferent);
3453     auto remPlusP =
3454         builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
3455     return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3456                                                  remainder);
3457   }
3458   // Real case
3459   auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
3460   mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
3461   auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
3462       loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
3463   auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
3464       loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
3465   auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
3466       loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
3467   auto argSignDifferent =
3468       builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
3469   auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3470                                                       argSignDifferent);
3471   auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
3472   return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3473                                                remainder);
3474 }
3475 
3476 // MVBITS
3477 void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
3478   // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
3479   //     FROMPOS >= 0
3480   //     LEN >= 0
3481   //     TOPOS >= 0
3482   //     FROMPOS + LEN <= BIT_SIZE(FROM)
3483   //     TOPOS + LEN <= BIT_SIZE(TO)
3484   // MASK = -1 >> (BIT_SIZE(FROM) - LEN)
3485   // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |
3486   //                      (((FROM >> FROMPOS) & MASK) << TOPOS)
3487   assert(args.size() == 5);
3488   auto unbox = [&](fir::ExtendedValue exv) {
3489     const mlir::Value *arg = exv.getUnboxed();
3490     assert(arg && "nonscalar mvbits argument");
3491     return *arg;
3492   };
3493   mlir::Value from = unbox(args[0]);
3494   mlir::Type resultType = from.getType();
3495   mlir::Value frompos = builder.createConvert(loc, resultType, unbox(args[1]));
3496   mlir::Value len = builder.createConvert(loc, resultType, unbox(args[2]));
3497   mlir::Value toAddr = unbox(args[3]);
3498   assert(fir::dyn_cast_ptrEleTy(toAddr.getType()) == resultType &&
3499          "mismatched mvbits types");
3500   auto to = builder.create<fir::LoadOp>(loc, resultType, toAddr);
3501   mlir::Value topos = builder.createConvert(loc, resultType, unbox(args[4]));
3502   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3503   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3504   mlir::Value bitSize = builder.createIntegerConstant(
3505       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3506   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
3507   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
3508   auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
3509   auto unchangedTmp2 =
3510       builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
3511   auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
3512   auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
3513   auto frombitsTmp2 =
3514       builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
3515   auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos);
3516   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
3517   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
3518       loc, mlir::arith::CmpIPredicate::eq, len, zero);
3519   auto res = builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
3520   builder.create<fir::StoreOp>(loc, res, toAddr);
3521 }
3522 
3523 // NEAREST
3524 mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
3525                                          llvm::ArrayRef<mlir::Value> args) {
3526   assert(args.size() == 2);
3527 
3528   mlir::Value realX = fir::getBase(args[0]);
3529   mlir::Value realS = fir::getBase(args[1]);
3530 
3531   return builder.createConvert(
3532       loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS));
3533 }
3534 
3535 // NINT
3536 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
3537                                       llvm::ArrayRef<mlir::Value> args) {
3538   assert(args.size() >= 1);
3539   // Skip optional kind argument to search the runtime; it is already reflected
3540   // in result type.
3541   return genRuntimeCall("nint", resultType, {args[0]});
3542 }
3543 
3544 // NOT
3545 mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
3546                                      llvm::ArrayRef<mlir::Value> args) {
3547   assert(args.size() == 1);
3548   mlir::Value allOnes = builder.createIntegerConstant(loc, resultType, -1);
3549   return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
3550 }
3551 
3552 // NULL
3553 fir::ExtendedValue
3554 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
3555   // NULL() without MOLD must be handled in the contexts where it can appear
3556   // (see table 16.5 of Fortran 2018 standard).
3557   assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
3558          "MOLD argument required to lower NULL outside of any context");
3559   const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
3560   assert(mold && "MOLD must be a pointer or allocatable");
3561   fir::BoxType boxType = mold->getBoxTy();
3562   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
3563   mlir::Value box = fir::factory::createUnallocatedBox(
3564       builder, loc, boxType, mold->nonDeferredLenParams());
3565   builder.create<fir::StoreOp>(loc, box, boxStorage);
3566   return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
3567 }
3568 
3569 // PACK
3570 fir::ExtendedValue
3571 IntrinsicLibrary::genPack(mlir::Type resultType,
3572                           llvm::ArrayRef<fir::ExtendedValue> args) {
3573   [[maybe_unused]] auto numArgs = args.size();
3574   assert(numArgs == 2 || numArgs == 3);
3575 
3576   // Handle required array argument
3577   mlir::Value array = builder.createBox(loc, args[0]);
3578 
3579   // Handle required mask argument
3580   mlir::Value mask = builder.createBox(loc, args[1]);
3581 
3582   // Handle optional vector argument
3583   mlir::Value vector = isStaticallyAbsent(args, 2)
3584                            ? builder.create<fir::AbsentOp>(
3585                                  loc, fir::BoxType::get(builder.getI1Type()))
3586                            : builder.createBox(loc, args[2]);
3587 
3588   // Create mutable fir.box to be passed to the runtime for the result.
3589   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
3590   fir::MutableBoxValue resultMutableBox =
3591       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3592   mlir::Value resultIrBox =
3593       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3594 
3595   fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
3596 
3597   return readAndAddCleanUp(resultMutableBox, resultType,
3598                            "unexpected result for PACK");
3599 }
3600 
3601 // POPCNT
3602 mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
3603                                         llvm::ArrayRef<mlir::Value> args) {
3604   assert(args.size() == 1);
3605 
3606   mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
3607 
3608   return builder.createConvert(loc, resultType, count);
3609 }
3610 
3611 // POPPAR
3612 mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,
3613                                         llvm::ArrayRef<mlir::Value> args) {
3614   assert(args.size() == 1);
3615 
3616   mlir::Value count = genPopcnt(resultType, args);
3617   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3618 
3619   return builder.create<mlir::arith::AndIOp>(loc, count, one);
3620 }
3621 
3622 // PRESENT
3623 fir::ExtendedValue
3624 IntrinsicLibrary::genPresent(mlir::Type,
3625                              llvm::ArrayRef<fir::ExtendedValue> args) {
3626   assert(args.size() == 1);
3627   return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
3628                                           fir::getBase(args[0]));
3629 }
3630 
3631 // PRODUCT
3632 fir::ExtendedValue
3633 IntrinsicLibrary::genProduct(mlir::Type resultType,
3634                              llvm::ArrayRef<fir::ExtendedValue> args) {
3635   return genProdOrSum(fir::runtime::genProduct, fir::runtime::genProductDim,
3636                       resultType, builder, loc, stmtCtx,
3637                       "unexpected result for Product", args);
3638 }
3639 
3640 // RANDOM_INIT
3641 void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
3642   assert(args.size() == 2);
3643   Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]),
3644                                 fir::getBase(args[1]));
3645 }
3646 
3647 // RANDOM_NUMBER
3648 void IntrinsicLibrary::genRandomNumber(
3649     llvm::ArrayRef<fir::ExtendedValue> args) {
3650   assert(args.size() == 1);
3651   Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
3652 }
3653 
3654 // RANDOM_SEED
3655 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
3656   assert(args.size() == 3);
3657   for (int i = 0; i < 3; ++i)
3658     if (isStaticallyPresent(args[i])) {
3659       Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i]));
3660       return;
3661     }
3662   Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
3663 }
3664 
3665 // REPEAT
3666 fir::ExtendedValue
3667 IntrinsicLibrary::genRepeat(mlir::Type resultType,
3668                             llvm::ArrayRef<fir::ExtendedValue> args) {
3669   assert(args.size() == 2);
3670   mlir::Value string = builder.createBox(loc, args[0]);
3671   mlir::Value ncopies = fir::getBase(args[1]);
3672   // Create mutable fir.box to be passed to the runtime for the result.
3673   fir::MutableBoxValue resultMutableBox =
3674       fir::factory::createTempMutableBox(builder, loc, resultType);
3675   mlir::Value resultIrBox =
3676       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3677   // Call runtime. The runtime is allocating the result.
3678   fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
3679   // Read result from mutable fir.box and add it to the list of temps to be
3680   // finalized by the StatementContext.
3681   return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
3682 }
3683 
3684 // RESHAPE
3685 fir::ExtendedValue
3686 IntrinsicLibrary::genReshape(mlir::Type resultType,
3687                              llvm::ArrayRef<fir::ExtendedValue> args) {
3688   assert(args.size() == 4);
3689 
3690   // Handle source argument
3691   mlir::Value source = builder.createBox(loc, args[0]);
3692 
3693   // Handle shape argument
3694   mlir::Value shape = builder.createBox(loc, args[1]);
3695   assert(fir::BoxValue(shape).rank() == 1);
3696   mlir::Type shapeTy = shape.getType();
3697   mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
3698   auto resultRank = shapeArrTy.cast<fir::SequenceType>().getShape()[0];
3699 
3700   if (resultRank == fir::SequenceType::getUnknownExtent())
3701     TODO(loc, "RESHAPE intrinsic requires computing rank of result");
3702 
3703   // Handle optional pad argument
3704   mlir::Value pad = isStaticallyAbsent(args[2])
3705                         ? builder.create<fir::AbsentOp>(
3706                               loc, fir::BoxType::get(builder.getI1Type()))
3707                         : builder.createBox(loc, args[2]);
3708 
3709   // Handle optional order argument
3710   mlir::Value order = isStaticallyAbsent(args[3])
3711                           ? builder.create<fir::AbsentOp>(
3712                                 loc, fir::BoxType::get(builder.getI1Type()))
3713                           : builder.createBox(loc, args[3]);
3714 
3715   // Create mutable fir.box to be passed to the runtime for the result.
3716   mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);
3717   fir::MutableBoxValue resultMutableBox =
3718       fir::factory::createTempMutableBox(builder, loc, type);
3719 
3720   mlir::Value resultIrBox =
3721       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3722 
3723   fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
3724                            order);
3725 
3726   return readAndAddCleanUp(resultMutableBox, resultType,
3727                            "unexpected result for RESHAPE");
3728 }
3729 
3730 // RRSPACING
3731 mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
3732                                            llvm::ArrayRef<mlir::Value> args) {
3733   assert(args.size() == 1);
3734 
3735   return builder.createConvert(
3736       loc, resultType,
3737       fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
3738 }
3739 
3740 // SCALE
3741 mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
3742                                        llvm::ArrayRef<mlir::Value> args) {
3743   assert(args.size() == 2);
3744 
3745   mlir::Value realX = fir::getBase(args[0]);
3746   mlir::Value intI = fir::getBase(args[1]);
3747 
3748   return builder.createConvert(
3749       loc, resultType, fir::runtime::genScale(builder, loc, realX, intI));
3750 }
3751 
3752 // SCAN
3753 fir::ExtendedValue
3754 IntrinsicLibrary::genScan(mlir::Type resultType,
3755                           llvm::ArrayRef<fir::ExtendedValue> args) {
3756 
3757   assert(args.size() == 4);
3758 
3759   if (isStaticallyAbsent(args[3])) {
3760     // Kind not specified, so call scan/verify runtime routine that is
3761     // specialized on the kind of characters in string.
3762 
3763     // Handle required string base arg
3764     mlir::Value stringBase = fir::getBase(args[0]);
3765 
3766     // Handle required set string base arg
3767     mlir::Value setBase = fir::getBase(args[1]);
3768 
3769     // Handle kind argument; it is the kind of character in this case
3770     fir::KindTy kind =
3771         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3772             stringBase.getType());
3773 
3774     // Get string length argument
3775     mlir::Value stringLen = fir::getLen(args[0]);
3776 
3777     // Get set string length argument
3778     mlir::Value setLen = fir::getLen(args[1]);
3779 
3780     // Handle optional back argument
3781     mlir::Value back =
3782         isStaticallyAbsent(args[2])
3783             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3784             : fir::getBase(args[2]);
3785 
3786     return builder.createConvert(loc, resultType,
3787                                  fir::runtime::genScan(builder, loc, kind,
3788                                                        stringBase, stringLen,
3789                                                        setBase, setLen, back));
3790   }
3791   // else use the runtime descriptor version of scan/verify
3792 
3793   // Handle optional argument, back
3794   auto makeRefThenEmbox = [&](mlir::Value b) {
3795     fir::LogicalType logTy = fir::LogicalType::get(
3796         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3797     mlir::Value temp = builder.createTemporary(loc, logTy);
3798     mlir::Value castb = builder.createConvert(loc, logTy, b);
3799     builder.create<fir::StoreOp>(loc, castb, temp);
3800     return builder.createBox(loc, temp);
3801   };
3802   mlir::Value back = fir::isUnboxedValue(args[2])
3803                          ? makeRefThenEmbox(*args[2].getUnboxed())
3804                          : builder.create<fir::AbsentOp>(
3805                                loc, fir::BoxType::get(builder.getI1Type()));
3806 
3807   // Handle required string argument
3808   mlir::Value string = builder.createBox(loc, args[0]);
3809 
3810   // Handle required set argument
3811   mlir::Value set = builder.createBox(loc, args[1]);
3812 
3813   // Handle kind argument
3814   mlir::Value kind = fir::getBase(args[3]);
3815 
3816   // Create result descriptor
3817   fir::MutableBoxValue resultMutableBox =
3818       fir::factory::createTempMutableBox(builder, loc, resultType);
3819   mlir::Value resultIrBox =
3820       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3821 
3822   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
3823                                   kind);
3824 
3825   // Handle cleanup of allocatable result descriptor and return
3826   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
3827 }
3828 
3829 // SET_EXPONENT
3830 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
3831                                              llvm::ArrayRef<mlir::Value> args) {
3832   assert(args.size() == 2);
3833 
3834   return builder.createConvert(
3835       loc, resultType,
3836       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
3837                                    fir::getBase(args[1])));
3838 }
3839 
3840 // SHIFTA, SHIFTL, SHIFTR
3841 template <typename Shift>
3842 mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
3843                                        llvm::ArrayRef<mlir::Value> args) {
3844   assert(args.size() == 2);
3845 
3846   // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by
3847   // the standard. However, several other compilers behave this way, so try and
3848   // maintain compatibility with them to an extent.
3849 
3850   unsigned bits = resultType.getIntOrFloatBitWidth();
3851   mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
3852   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3853   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3854 
3855   mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
3856       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
3857   mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>(
3858       loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
3859   mlir::Value outOfBounds =
3860       builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
3861 
3862   mlir::Value shifted = builder.create<Shift>(loc, args[0], shift);
3863   return builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
3864 }
3865 
3866 // SIGN
3867 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
3868                                       llvm::ArrayRef<mlir::Value> args) {
3869   assert(args.size() == 2);
3870   if (resultType.isa<mlir::IntegerType>()) {
3871     mlir::Value abs = genAbs(resultType, {args[0]});
3872     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3873     auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
3874     auto cmp = builder.create<mlir::arith::CmpIOp>(
3875         loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
3876     return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
3877   }
3878   return genRuntimeCall("sign", resultType, args);
3879 }
3880 
3881 // SIZE
3882 fir::ExtendedValue
3883 IntrinsicLibrary::genSize(mlir::Type resultType,
3884                           llvm::ArrayRef<fir::ExtendedValue> args) {
3885   // Note that the value of the KIND argument is already reflected in the
3886   // resultType
3887   assert(args.size() == 3);
3888   if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
3889     if (boxValue->hasAssumedRank())
3890       TODO(loc, "SIZE intrinsic with assumed rank argument");
3891 
3892   // Get the ARRAY argument
3893   mlir::Value array = builder.createBox(loc, args[0]);
3894 
3895   // The front-end rewrites SIZE without the DIM argument to
3896   // an array of SIZE with DIM in most cases, but it may not be
3897   // possible in some cases like when in SIZE(function_call()).
3898   if (isStaticallyAbsent(args, 1))
3899     return builder.createConvert(loc, resultType,
3900                                  fir::runtime::genSize(builder, loc, array));
3901 
3902   // Get the DIM argument.
3903   mlir::Value dim = fir::getBase(args[1]);
3904   if (!fir::isa_ref_type(dim.getType()))
3905     return builder.createConvert(
3906         loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
3907 
3908   mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);
3909   return builder
3910       .genIfOp(loc, {resultType}, isDynamicallyAbsent,
3911                /*withElseRegion=*/true)
3912       .genThen([&]() {
3913         mlir::Value size = builder.createConvert(
3914             loc, resultType, fir::runtime::genSize(builder, loc, array));
3915         builder.create<fir::ResultOp>(loc, size);
3916       })
3917       .genElse([&]() {
3918         mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
3919         mlir::Value size = builder.createConvert(
3920             loc, resultType,
3921             fir::runtime::genSizeDim(builder, loc, array, dimValue));
3922         builder.create<fir::ResultOp>(loc, size);
3923       })
3924       .getResults()[0];
3925 }
3926 
3927 // TRAILZ
3928 mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,
3929                                         llvm::ArrayRef<mlir::Value> args) {
3930   assert(args.size() == 1);
3931 
3932   mlir::Value result =
3933       builder.create<mlir::math::CountTrailingZerosOp>(loc, args);
3934 
3935   return builder.createConvert(loc, resultType, result);
3936 }
3937 
3938 static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {
3939   return exv.match(
3940       [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },
3941       [](const fir::CharArrayBoxValue &arr) {
3942         return arr.getLBounds().empty();
3943       },
3944       [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },
3945       [](const auto &) { return false; });
3946 }
3947 
3948 /// Compute the lower bound in dimension \p dim (zero based) of \p array
3949 /// taking care of returning one when the related extent is zero.
3950 static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
3951                                  const fir::ExtendedValue &array, unsigned dim,
3952                                  mlir::Value zero, mlir::Value one) {
3953   assert(dim < array.rank() && "invalid dimension");
3954   if (hasDefaultLowerBound(array))
3955     return one;
3956   mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
3957   if (dim + 1 == array.rank() && array.isAssumedSize())
3958     return lb;
3959   mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
3960   zero = builder.createConvert(loc, extent.getType(), zero);
3961   auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
3962       loc, mlir::arith::CmpIPredicate::eq, extent, zero);
3963   one = builder.createConvert(loc, lb.getType(), one);
3964   return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
3965 }
3966 
3967 /// Create a fir.box to be passed to the LBOUND runtime.
3968 /// This ensure that local lower bounds of assumed shape are propagated and that
3969 /// a fir.box with equivalent LBOUNDs but an explicit shape is created for
3970 /// assumed size arrays to avoid undefined behaviors in codegen or the runtime.
3971 static mlir::Value createBoxForLBOUND(mlir::Location loc,
3972                                       fir::FirOpBuilder &builder,
3973                                       const fir::ExtendedValue &array) {
3974   if (!array.isAssumedSize())
3975     return array.match(
3976         [&](const fir::BoxValue &boxValue) -> mlir::Value {
3977           // This entity is mapped to a fir.box that may not contain the local
3978           // lower bound information if it is a dummy. Rebox it with the local
3979           // shape information.
3980           mlir::Value localShape = builder.createShape(loc, array);
3981           mlir::Value oldBox = boxValue.getAddr();
3982           return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
3983                                               localShape,
3984                                               /*slice=*/mlir::Value{});
3985         },
3986         [&](const auto &) -> mlir::Value {
3987           // This a pointer/allocatable, or an entity not yet tracked with a
3988           // fir.box. For pointer/allocatable, createBox will forward the
3989           // descriptor that contains the correct lower bound information. For
3990           // other entities, a new fir.box will be made with the local lower
3991           // bounds.
3992           return builder.createBox(loc, array);
3993         });
3994   // Assumed sized are not meant to be emboxed. This could cause the undefined
3995   // extent cannot safely be understood by the runtime/codegen that will
3996   // consider that the dimension is empty and that the related LBOUND value must
3997   // be one. Pretend that the related extent is one to get the correct LBOUND
3998   // value.
3999   llvm::SmallVector<mlir::Value> shape =
4000       fir::factory::getExtents(loc, builder, array);
4001   assert(!shape.empty() && "assumed size must have at least one dimension");
4002   shape.back() = builder.createIntegerConstant(loc, builder.getIndexType(), 1);
4003   auto safeToEmbox = array.match(
4004       [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue {
4005         return fir::CharArrayBoxValue{x.getAddr(), x.getLen(), shape,
4006                                       x.getLBounds()};
4007       },
4008       [&](const fir::ArrayBoxValue &x) -> fir::ExtendedValue {
4009         return fir::ArrayBoxValue{x.getAddr(), shape, x.getLBounds()};
4010       },
4011       [&](const auto &) -> fir::ExtendedValue {
4012         fir::emitFatalError(loc, "not an assumed size array");
4013       });
4014   return builder.createBox(loc, safeToEmbox);
4015 }
4016 
4017 // LBOUND
4018 fir::ExtendedValue
4019 IntrinsicLibrary::genLbound(mlir::Type resultType,
4020                             llvm::ArrayRef<fir::ExtendedValue> args) {
4021   assert(args.size() == 2 || args.size() == 3);
4022   const fir::ExtendedValue &array = args[0];
4023   if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
4024     if (boxValue->hasAssumedRank())
4025       TODO(loc, "LBOUND intrinsic with assumed rank argument");
4026 
4027   //===----------------------------------------------------------------------===//
4028   mlir::Type indexType = builder.getIndexType();
4029 
4030   // Semantics builds signatures for LBOUND calls as either
4031   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
4032   if (args.size() == 2 || isStaticallyAbsent(args, 1)) {
4033     // DIM is absent.
4034     mlir::Type lbType = fir::unwrapSequenceType(resultType);
4035     unsigned rank = array.rank();
4036     mlir::Type lbArrayType = fir::SequenceType::get(
4037         {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);
4038     mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);
4039     mlir::Type lbAddrType = builder.getRefType(lbType);
4040     mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);
4041     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
4042     for (unsigned dim = 0; dim < rank; ++dim) {
4043       mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);
4044       lb = builder.createConvert(loc, lbType, lb);
4045       auto index = builder.createIntegerConstant(loc, indexType, dim);
4046       auto lbAddr =
4047           builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index);
4048       builder.create<fir::StoreOp>(loc, lb, lbAddr);
4049     }
4050     mlir::Value lbArrayExtent =
4051         builder.createIntegerConstant(loc, indexType, rank);
4052     llvm::SmallVector<mlir::Value> extents{lbArrayExtent};
4053     return fir::ArrayBoxValue{lbArray, extents};
4054   }
4055   // DIM is present.
4056   mlir::Value dim = fir::getBase(args[1]);
4057 
4058   // If it is a compile time constant, skip the runtime call.
4059   if (llvm::Optional<std::int64_t> cstDim =
4060           fir::factory::getIntIfConstant(dim)) {
4061     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
4062     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
4063     mlir::Value lb = computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
4064     return builder.createConvert(loc, resultType, lb);
4065   }
4066 
4067   fir::ExtendedValue box = createBoxForLBOUND(loc, builder, array);
4068   return builder.createConvert(
4069       loc, resultType,
4070       fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
4071 }
4072 
4073 // UBOUND
4074 fir::ExtendedValue
4075 IntrinsicLibrary::genUbound(mlir::Type resultType,
4076                             llvm::ArrayRef<fir::ExtendedValue> args) {
4077   assert(args.size() == 3 || args.size() == 2);
4078   if (args.size() == 3) {
4079     // Handle calls to UBOUND with the DIM argument, which return a scalar
4080     mlir::Value extent = fir::getBase(genSize(resultType, args));
4081     mlir::Value lbound = fir::getBase(genLbound(resultType, args));
4082 
4083     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
4084     mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
4085     return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
4086   } else {
4087     // Handle calls to UBOUND without the DIM argument, which return an array
4088     mlir::Value kind = isStaticallyAbsent(args[1])
4089                            ? builder.createIntegerConstant(
4090                                  loc, builder.getIndexType(),
4091                                  builder.getKindMap().defaultIntegerKind())
4092                            : fir::getBase(args[1]);
4093 
4094     // Create mutable fir.box to be passed to the runtime for the result.
4095     mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
4096     fir::MutableBoxValue resultMutableBox =
4097         fir::factory::createTempMutableBox(builder, loc, type);
4098     mlir::Value resultIrBox =
4099         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4100 
4101     fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(args[0]),
4102                             kind);
4103 
4104     return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
4105   }
4106   return mlir::Value();
4107 }
4108 
4109 // SPACING
4110 mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
4111                                          llvm::ArrayRef<mlir::Value> args) {
4112   assert(args.size() == 1);
4113 
4114   return builder.createConvert(
4115       loc, resultType,
4116       fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
4117 }
4118 
4119 // SPREAD
4120 fir::ExtendedValue
4121 IntrinsicLibrary::genSpread(mlir::Type resultType,
4122                             llvm::ArrayRef<fir::ExtendedValue> args) {
4123 
4124   assert(args.size() == 3);
4125 
4126   // Handle source argument
4127   mlir::Value source = builder.createBox(loc, args[0]);
4128   fir::BoxValue sourceTmp = source;
4129   unsigned sourceRank = sourceTmp.rank();
4130 
4131   // Handle Dim argument
4132   mlir::Value dim = fir::getBase(args[1]);
4133 
4134   // Handle ncopies argument
4135   mlir::Value ncopies = fir::getBase(args[2]);
4136 
4137   // Generate result descriptor
4138   mlir::Type resultArrayType =
4139       builder.getVarLenSeqTy(resultType, sourceRank + 1);
4140   fir::MutableBoxValue resultMutableBox =
4141       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4142   mlir::Value resultIrBox =
4143       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4144 
4145   fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
4146 
4147   return readAndAddCleanUp(resultMutableBox, resultType,
4148                            "unexpected result for SPREAD");
4149 }
4150 
4151 // SUM
4152 fir::ExtendedValue
4153 IntrinsicLibrary::genSum(mlir::Type resultType,
4154                          llvm::ArrayRef<fir::ExtendedValue> args) {
4155   return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
4156                       builder, loc, stmtCtx, "unexpected result for Sum", args);
4157 }
4158 
4159 // SYSTEM_CLOCK
4160 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
4161   assert(args.size() == 3);
4162   Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
4163                                  fir::getBase(args[1]), fir::getBase(args[2]));
4164 }
4165 
4166 // TRANSFER
4167 fir::ExtendedValue
4168 IntrinsicLibrary::genTransfer(mlir::Type resultType,
4169                               llvm::ArrayRef<fir::ExtendedValue> args) {
4170 
4171   assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
4172 
4173   // Handle source argument
4174   mlir::Value source = builder.createBox(loc, args[0]);
4175 
4176   // Handle mold argument
4177   mlir::Value mold = builder.createBox(loc, args[1]);
4178   fir::BoxValue moldTmp = mold;
4179   unsigned moldRank = moldTmp.rank();
4180 
4181   bool absentSize = (args.size() == 2);
4182 
4183   // Create mutable fir.box to be passed to the runtime for the result.
4184   mlir::Type type = (moldRank == 0 && absentSize)
4185                         ? resultType
4186                         : builder.getVarLenSeqTy(resultType, 1);
4187   fir::MutableBoxValue resultMutableBox =
4188       fir::factory::createTempMutableBox(builder, loc, type);
4189 
4190   if (moldRank == 0 && absentSize) {
4191     // This result is a scalar in this case.
4192     mlir::Value resultIrBox =
4193         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4194 
4195     Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4196   } else {
4197     // The result is a rank one array in this case.
4198     mlir::Value resultIrBox =
4199         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4200 
4201     if (absentSize) {
4202       Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4203     } else {
4204       mlir::Value sizeArg = fir::getBase(args[2]);
4205       Fortran::lower::genTransferSize(builder, loc, resultIrBox, source, mold,
4206                                       sizeArg);
4207     }
4208   }
4209   return readAndAddCleanUp(resultMutableBox, resultType,
4210                            "unexpected result for TRANSFER");
4211 }
4212 
4213 // TRANSPOSE
4214 fir::ExtendedValue
4215 IntrinsicLibrary::genTranspose(mlir::Type resultType,
4216                                llvm::ArrayRef<fir::ExtendedValue> args) {
4217 
4218   assert(args.size() == 1);
4219 
4220   // Handle source argument
4221   mlir::Value source = builder.createBox(loc, args[0]);
4222 
4223   // Create mutable fir.box to be passed to the runtime for the result.
4224   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
4225   fir::MutableBoxValue resultMutableBox =
4226       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4227   mlir::Value resultIrBox =
4228       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4229   // Call runtime. The runtime is allocating the result.
4230   fir::runtime::genTranspose(builder, loc, resultIrBox, source);
4231   // Read result from mutable fir.box and add it to the list of temps to be
4232   // finalized by the StatementContext.
4233   return readAndAddCleanUp(resultMutableBox, resultType,
4234                            "unexpected result for TRANSPOSE");
4235 }
4236 
4237 // TRIM
4238 fir::ExtendedValue
4239 IntrinsicLibrary::genTrim(mlir::Type resultType,
4240                           llvm::ArrayRef<fir::ExtendedValue> args) {
4241   assert(args.size() == 1);
4242   mlir::Value string = builder.createBox(loc, args[0]);
4243   // Create mutable fir.box to be passed to the runtime for the result.
4244   fir::MutableBoxValue resultMutableBox =
4245       fir::factory::createTempMutableBox(builder, loc, resultType);
4246   mlir::Value resultIrBox =
4247       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4248   // Call runtime. The runtime is allocating the result.
4249   fir::runtime::genTrim(builder, loc, resultIrBox, string);
4250   // Read result from mutable fir.box and add it to the list of temps to be
4251   // finalized by the StatementContext.
4252   return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
4253 }
4254 
4255 // Compare two FIR values and return boolean result as i1.
4256 template <Extremum extremum, ExtremumBehavior behavior>
4257 static mlir::Value createExtremumCompare(mlir::Location loc,
4258                                          fir::FirOpBuilder &builder,
4259                                          mlir::Value left, mlir::Value right) {
4260   static constexpr mlir::arith::CmpIPredicate integerPredicate =
4261       extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
4262                                 : mlir::arith::CmpIPredicate::slt;
4263   static constexpr mlir::arith::CmpFPredicate orderedCmp =
4264       extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
4265                                 : mlir::arith::CmpFPredicate::OLT;
4266   mlir::Type type = left.getType();
4267   mlir::Value result;
4268   if (fir::isa_real(type)) {
4269     // Note: the signaling/quit aspect of the result required by IEEE
4270     // cannot currently be obtained with LLVM without ad-hoc runtime.
4271     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
4272       // Return the number if one of the inputs is NaN and the other is
4273       // a number.
4274       auto leftIsResult =
4275           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4276       auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
4277           loc, mlir::arith::CmpFPredicate::UNE, right, right);
4278       result =
4279           builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
4280     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
4281       // Always return NaNs if one the input is NaNs
4282       auto leftIsResult =
4283           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4284       auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
4285           loc, mlir::arith::CmpFPredicate::UNE, left, left);
4286       result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
4287     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
4288       // If the left is a NaN, return the right whatever it is.
4289       result =
4290           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4291     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
4292       // If one of the operand is a NaN, return left whatever it is.
4293       static constexpr auto unorderedCmp =
4294           extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
4295                                     : mlir::arith::CmpFPredicate::ULT;
4296       result =
4297           builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
4298     } else {
4299       // TODO: ieeeMinNum/ieeeMaxNum
4300       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
4301                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
4302     }
4303   } else if (fir::isa_integer(type)) {
4304     result =
4305         builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
4306   } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
4307     // TODO: ! character min and max is tricky because the result
4308     // length is the length of the longest argument!
4309     // So we may need a temp.
4310     TODO(loc, "CHARACTER min and max");
4311   }
4312   assert(result && "result must be defined");
4313   return result;
4314 }
4315 
4316 // UNPACK
4317 fir::ExtendedValue
4318 IntrinsicLibrary::genUnpack(mlir::Type resultType,
4319                             llvm::ArrayRef<fir::ExtendedValue> args) {
4320   assert(args.size() == 3);
4321 
4322   // Handle required vector argument
4323   mlir::Value vector = builder.createBox(loc, args[0]);
4324 
4325   // Handle required mask argument
4326   fir::BoxValue maskBox = builder.createBox(loc, args[1]);
4327   mlir::Value mask = fir::getBase(maskBox);
4328   unsigned maskRank = maskBox.rank();
4329 
4330   // Handle required field argument
4331   mlir::Value field = builder.createBox(loc, args[2]);
4332 
4333   // Create mutable fir.box to be passed to the runtime for the result.
4334   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
4335   fir::MutableBoxValue resultMutableBox =
4336       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4337   mlir::Value resultIrBox =
4338       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4339 
4340   fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
4341 
4342   return readAndAddCleanUp(resultMutableBox, resultType,
4343                            "unexpected result for UNPACK");
4344 }
4345 
4346 // VERIFY
4347 fir::ExtendedValue
4348 IntrinsicLibrary::genVerify(mlir::Type resultType,
4349                             llvm::ArrayRef<fir::ExtendedValue> args) {
4350 
4351   assert(args.size() == 4);
4352 
4353   if (isStaticallyAbsent(args[3])) {
4354     // Kind not specified, so call scan/verify runtime routine that is
4355     // specialized on the kind of characters in string.
4356 
4357     // Handle required string base arg
4358     mlir::Value stringBase = fir::getBase(args[0]);
4359 
4360     // Handle required set string base arg
4361     mlir::Value setBase = fir::getBase(args[1]);
4362 
4363     // Handle kind argument; it is the kind of character in this case
4364     fir::KindTy kind =
4365         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
4366             stringBase.getType());
4367 
4368     // Get string length argument
4369     mlir::Value stringLen = fir::getLen(args[0]);
4370 
4371     // Get set string length argument
4372     mlir::Value setLen = fir::getLen(args[1]);
4373 
4374     // Handle optional back argument
4375     mlir::Value back =
4376         isStaticallyAbsent(args[2])
4377             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
4378             : fir::getBase(args[2]);
4379 
4380     return builder.createConvert(
4381         loc, resultType,
4382         fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
4383                                 setBase, setLen, back));
4384   }
4385   // else use the runtime descriptor version of scan/verify
4386 
4387   // Handle optional argument, back
4388   auto makeRefThenEmbox = [&](mlir::Value b) {
4389     fir::LogicalType logTy = fir::LogicalType::get(
4390         builder.getContext(), builder.getKindMap().defaultLogicalKind());
4391     mlir::Value temp = builder.createTemporary(loc, logTy);
4392     mlir::Value castb = builder.createConvert(loc, logTy, b);
4393     builder.create<fir::StoreOp>(loc, castb, temp);
4394     return builder.createBox(loc, temp);
4395   };
4396   mlir::Value back = fir::isUnboxedValue(args[2])
4397                          ? makeRefThenEmbox(*args[2].getUnboxed())
4398                          : builder.create<fir::AbsentOp>(
4399                                loc, fir::BoxType::get(builder.getI1Type()));
4400 
4401   // Handle required string argument
4402   mlir::Value string = builder.createBox(loc, args[0]);
4403 
4404   // Handle required set argument
4405   mlir::Value set = builder.createBox(loc, args[1]);
4406 
4407   // Handle kind argument
4408   mlir::Value kind = fir::getBase(args[3]);
4409 
4410   // Create result descriptor
4411   fir::MutableBoxValue resultMutableBox =
4412       fir::factory::createTempMutableBox(builder, loc, resultType);
4413   mlir::Value resultIrBox =
4414       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4415 
4416   fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
4417                                     back, kind);
4418 
4419   // Handle cleanup of allocatable result descriptor and return
4420   return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
4421 }
4422 
4423 // MAXLOC
4424 fir::ExtendedValue
4425 IntrinsicLibrary::genMaxloc(mlir::Type resultType,
4426                             llvm::ArrayRef<fir::ExtendedValue> args) {
4427   return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
4428                         resultType, builder, loc, stmtCtx,
4429                         "unexpected result for Maxloc", args);
4430 }
4431 
4432 // MAXVAL
4433 fir::ExtendedValue
4434 IntrinsicLibrary::genMaxval(mlir::Type resultType,
4435                             llvm::ArrayRef<fir::ExtendedValue> args) {
4436   return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
4437                         fir::runtime::genMaxvalChar, resultType, builder, loc,
4438                         stmtCtx, "unexpected result for Maxval", args);
4439 }
4440 
4441 // MINLOC
4442 fir::ExtendedValue
4443 IntrinsicLibrary::genMinloc(mlir::Type resultType,
4444                             llvm::ArrayRef<fir::ExtendedValue> args) {
4445   return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
4446                         resultType, builder, loc, stmtCtx,
4447                         "unexpected result for Minloc", args);
4448 }
4449 
4450 // MINVAL
4451 fir::ExtendedValue
4452 IntrinsicLibrary::genMinval(mlir::Type resultType,
4453                             llvm::ArrayRef<fir::ExtendedValue> args) {
4454   return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
4455                         fir::runtime::genMinvalChar, resultType, builder, loc,
4456                         stmtCtx, "unexpected result for Minval", args);
4457 }
4458 
4459 // MIN and MAX
4460 template <Extremum extremum, ExtremumBehavior behavior>
4461 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
4462                                           llvm::ArrayRef<mlir::Value> args) {
4463   assert(args.size() >= 1);
4464   mlir::Value result = args[0];
4465   for (auto arg : args.drop_front()) {
4466     mlir::Value mask =
4467         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
4468     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
4469   }
4470   return result;
4471 }
4472 
4473 //===----------------------------------------------------------------------===//
4474 // Argument lowering rules interface
4475 //===----------------------------------------------------------------------===//
4476 
4477 const Fortran::lower::IntrinsicArgumentLoweringRules *
4478 Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
4479   if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName))
4480     if (!handler->argLoweringRules.hasDefaultRules())
4481       return &handler->argLoweringRules;
4482   return nullptr;
4483 }
4484 
4485 /// Return how argument \p argName should be lowered given the rules for the
4486 /// intrinsic function.
4487 Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
4488     const IntrinsicArgumentLoweringRules &rules, unsigned position) {
4489   assert(position < sizeof(rules.args) / sizeof(decltype(*rules.args)) &&
4490          "invalid argument");
4491   return {rules.args[position].lowerAs,
4492           rules.args[position].handleDynamicOptional};
4493 }
4494 
4495 //===----------------------------------------------------------------------===//
4496 // Public intrinsic call helpers
4497 //===----------------------------------------------------------------------===//
4498 
4499 fir::ExtendedValue
4500 Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
4501                                  llvm::StringRef name,
4502                                  llvm::Optional<mlir::Type> resultType,
4503                                  llvm::ArrayRef<fir::ExtendedValue> args,
4504                                  Fortran::lower::StatementContext &stmtCtx) {
4505   return IntrinsicLibrary{builder, loc, &stmtCtx}.genIntrinsicCall(
4506       name, resultType, args);
4507 }
4508 
4509 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
4510                                    mlir::Location loc,
4511                                    llvm::ArrayRef<mlir::Value> args) {
4512   assert(args.size() > 0 && "max requires at least one argument");
4513   return IntrinsicLibrary{builder, loc}
4514       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
4515                                                               args);
4516 }
4517 
4518 mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder,
4519                                    mlir::Location loc,
4520                                    llvm::ArrayRef<mlir::Value> args) {
4521   assert(args.size() > 0 && "min requires at least one argument");
4522   return IntrinsicLibrary{builder, loc}
4523       .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
4524                                                               args);
4525 }
4526 
4527 mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
4528                                    mlir::Location loc, mlir::Type type,
4529                                    mlir::Value x, mlir::Value y) {
4530   // TODO: since there is no libm version of pow with integer exponent,
4531   //       we have to provide an alternative implementation for
4532   //       "precise/strict" FP mode and (!lowerEarlyToLibCall).
4533   //       One option is to generate internal function with inlined
4534   //       implementation and mark it 'strictfp'.
4535   //       Another option is to implement it in Fortran runtime library
4536   //       (just like matmul).
4537   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
4538 }
4539 
4540 mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
4541     fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
4542     mlir::FunctionType signature) {
4543   return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
4544       name, signature);
4545 }
4546