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