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