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