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