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