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