flang/lib/Lower/IntrinsicCall.cpp

   1 //===-- IntrinsicCall.cpp -------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8 //
   9 // Helper routines for constructing the FIR dialect of MLIR. As FIR is a
  10 // dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding
  11 // style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this
  12 // module.
  13 //
  14 //===----------------------------------------------------------------------===//
  15
  16 #include "flang/Lower/IntrinsicCall.h"
  17 #include "flang/Common/static-multimap-view.h"
  18 #include "flang/Lower/Mangler.h"
  19 #include "flang/Lower/Runtime.h"
  20 #include "flang/Lower/StatementContext.h"
  21 #include "flang/Lower/SymbolMap.h"
  22 #include "flang/Optimizer/Builder/Character.h"
  23 #include "flang/Optimizer/Builder/Complex.h"
  24 #include "flang/Optimizer/Builder/FIRBuilder.h"
  25 #include "flang/Optimizer/Builder/MutableBox.h"
  26 #include "flang/Optimizer/Builder/Runtime/Character.h"
  27 #include "flang/Optimizer/Builder/Runtime/Command.h"
  28 #include "flang/Optimizer/Builder/Runtime/Inquiry.h"
  29 #include "flang/Optimizer/Builder/Runtime/Numeric.h"
  30 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
  31 #include "flang/Optimizer/Builder/Runtime/Reduction.h"
  32 #include "flang/Optimizer/Builder/Runtime/Stop.h"
  33 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
  34 #include "flang/Optimizer/Builder/Todo.h"
  35 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
  36 #include "flang/Optimizer/Support/FatalError.h"
  37 #include "flang/Runtime/entry-names.h"
  38 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
  39 #include "mlir/Dialect/Math/IR/Math.h"
  40 #include "llvm/Support/CommandLine.h"
  41 #include "llvm/Support/Debug.h"
  42
  43 #define DEBUG_TYPE "flang-lower-intrinsic"
  44
  45 #define PGMATH_DECLARE
  46 #include "flang/Evaluate/pgmath.h.inc"
  47
  48 /// This file implements lowering of Fortran intrinsic procedures and Fortran
  49 /// intrinsic module procedures.  A call may be inlined with a mix of FIR and
  50 /// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
  51
  52 /// Lowering of intrinsic procedure calls is based on a map that associates
  53 /// Fortran intrinsic generic names to FIR generator functions.
  54 /// All generator functions are member functions of the IntrinsicLibrary class
  55 /// and have the same interface.
  56 /// If no generator is given for an intrinsic name, a math runtime library
  57 /// is searched for an implementation and, if a runtime function is found,
  58 /// a call is generated for it. LLVM intrinsics are handled as a math
  59 /// runtime library here.
  60
  61 /// Enums used to templatize and share lowering of MIN and MAX.
  62 enum class Extremum { Min, Max };
  63
  64 // There are different ways to deal with NaNs in MIN and MAX.
  65 // Known existing behaviors are listed below and can be selected for
  66 // f18 MIN/MAX implementation.
  67 enum class ExtremumBehavior {
  68   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
  69   // not described because there is no way to control/observe such aspect in
  70   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
  71   // aspect that are therefore currently not enforced. In the descriptions
  72   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
  73   // if one of the input NaN was signaling but it cannot be guaranteed either.
  74   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
  75   // signaling/quiet requirements.
  76   IeeeMinMaximumNumber,
  77   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
  78   // If one of the argument is and number and the other is NaN, return the
  79   // number. If both arguements are NaN, return NaN.
  80   // Compilers: gfortran.
  81   IeeeMinMaximum,
  82   // IEEE minimum/maximum behavior (754-2019, section 9.6):
  83   // If one of the argument is NaN, return NaN.
  84   MinMaxss,
  85   // x86 minss/maxss behavior:
  86   // If the second argument is a number and the other is NaN, return the number.
  87   // In all other cases where at least one operand is NaN, return NaN.
  88   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
  89   PgfortranLlvm,
  90   // "Opposite of" x86 minss/maxss behavior:
  91   // If the first argument is a number and the other is NaN, return the
  92   // number.
  93   // In all other cases where at least one operand is NaN, return NaN.
  94   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
  95   IeeeMinMaxNum
  96   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
  97   // TODO: Not implemented.
  98   // It is the only behavior where the signaling/quiet aspect of a NaN argument
  99   // impacts if the result should be NaN or the argument that is a number.
 100   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
 101   // possible to implement it without some target dependent runtime.
 102 };
 103
 104 fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() {
 105   return fir::UnboxedValue{};
 106 }
 107
 108 /// Test if an ExtendedValue is absent. This is used to test if an intrinsic
 109 /// argument are absent at compile time.
 110 static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {
 111   return !fir::getBase(exv);
 112 }
 113 static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,
 114                                size_t argIndex) {
 115   return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);
 116 }
 117 static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
 118                                size_t argIndex) {
 119   return args.size() <= argIndex || !args[argIndex];
 120 }
 121
 122 /// Test if an ExtendedValue is present. This is used to test if an intrinsic
 123 /// argument is present at compile time. This does not imply that the related
 124 /// value may not be an absent dummy optional, disassociated pointer, or a
 125 /// deallocated allocatable. See `handleDynamicOptional` to deal with these
 126 /// cases when it makes sense.
 127 static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
 128   return !isStaticallyAbsent(exv);
 129 }
 130
 131 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
 132 /// take a DIM argument.
 133 template <typename FD>
 134 static fir::ExtendedValue
 135 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
 136            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
 137            llvm::StringRef errMsg, mlir::Value array, fir::ExtendedValue dimArg,
 138            mlir::Value mask, int rank) {
 139
 140   // Create mutable fir.box to be passed to the runtime for the result.
 141   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
 142   fir::MutableBoxValue resultMutableBox =
 143       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
 144   mlir::Value resultIrBox =
 145       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
 146
 147   mlir::Value dim =
 148       isStaticallyAbsent(dimArg)
 149           ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
 150           : fir::getBase(dimArg);
 151   funcDim(builder, loc, resultIrBox, array, dim, mask);
 152
 153   fir::ExtendedValue res =
 154       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
 155   return res.match(
 156       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
 157         // Add cleanup code
 158         assert(stmtCtx);
 159         fir::FirOpBuilder *bldr = &builder;
 160         mlir::Value temp = box.getAddr();
 161         stmtCtx->attachCleanup(
 162             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
 163         return box;
 164       },
 165       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
 166         // Add cleanup code
 167         assert(stmtCtx);
 168         fir::FirOpBuilder *bldr = &builder;
 169         mlir::Value temp = box.getAddr();
 170         stmtCtx->attachCleanup(
 171             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
 172         return box;
 173       },
 174       [&](const auto &) -> fir::ExtendedValue {
 175         fir::emitFatalError(loc, errMsg);
 176       });
 177 }
 178
 179 /// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions
 180 template <typename FN, typename FD>
 181 static fir::ExtendedValue
 182 genReduction(FN func, FD funcDim, mlir::Type resultType,
 183              fir::FirOpBuilder &builder, mlir::Location loc,
 184              Fortran::lower::StatementContext *stmtCtx, llvm::StringRef errMsg,
 185              llvm::ArrayRef<fir::ExtendedValue> args) {
 186
 187   assert(args.size() == 3);
 188
 189   // Handle required array argument
 190   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
 191   mlir::Value array = fir::getBase(arryTmp);
 192   int rank = arryTmp.rank();
 193   assert(rank >= 1);
 194
 195   // Handle optional mask argument
 196   auto mask = isStaticallyAbsent(args[2])
 197                   ? builder.create<fir::AbsentOp>(
 198                         loc, fir::BoxType::get(builder.getI1Type()))
 199                   : builder.createBox(loc, args[2]);
 200
 201   bool absentDim = isStaticallyAbsent(args[1]);
 202
 203   // We call the type specific versions because the result is scalar
 204   // in the case below.
 205   if (absentDim || rank == 1) {
 206     mlir::Type ty = array.getType();
 207     mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
 208     auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
 209     if (fir::isa_complex(eleTy)) {
 210       mlir::Value result = builder.createTemporary(loc, eleTy);
 211       func(builder, loc, array, mask, result);
 212       return builder.create<fir::LoadOp>(loc, result);
 213     }
 214     auto resultBox = builder.create<fir::AbsentOp>(
 215         loc, fir::BoxType::get(builder.getI1Type()));
 216     return func(builder, loc, array, mask, resultBox);
 217   }
 218   // Handle Product/Sum cases that have an array result.
 219   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
 220                     args[1], mask, rank);
 221 }
 222
 223 /// Process calls to DotProduct
 224 template <typename FN>
 225 static fir::ExtendedValue
 226 genDotProd(FN func, mlir::Type resultType, fir::FirOpBuilder &builder,
 227            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
 228            llvm::ArrayRef<fir::ExtendedValue> args) {
 229
 230   assert(args.size() == 2);
 231
 232   // Handle required vector arguments
 233   mlir::Value vectorA = fir::getBase(args[0]);
 234   mlir::Value vectorB = fir::getBase(args[1]);
 235   // Result type is used for picking appropriate runtime function.
 236   mlir::Type eleTy = resultType;
 237
 238   if (fir::isa_complex(eleTy)) {
 239     mlir::Value result = builder.createTemporary(loc, eleTy);
 240     func(builder, loc, vectorA, vectorB, result);
 241     return builder.create<fir::LoadOp>(loc, result);
 242   }
 243
 244   // This operation is only used to pass the result type
 245   // information to the DotProduct generator.
 246   auto resultBox = builder.create<fir::AbsentOp>(loc, fir::BoxType::get(eleTy));
 247   return func(builder, loc, vectorA, vectorB, resultBox);
 248 }
 249
 250 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions
 251 template <typename FN, typename FD, typename FC>
 252 static fir::ExtendedValue
 253 genExtremumVal(FN func, FD funcDim, FC funcChar, mlir::Type resultType,
 254                fir::FirOpBuilder &builder, mlir::Location loc,
 255                Fortran::lower::StatementContext *stmtCtx,
 256                llvm::StringRef errMsg,
 257                llvm::ArrayRef<fir::ExtendedValue> args) {
 258
 259   assert(args.size() == 3);
 260
 261   // Handle required array argument
 262   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
 263   mlir::Value array = fir::getBase(arryTmp);
 264   int rank = arryTmp.rank();
 265   assert(rank >= 1);
 266   bool hasCharacterResult = arryTmp.isCharacter();
 267
 268   // Handle optional mask argument
 269   auto mask = isStaticallyAbsent(args[2])
 270                   ? builder.create<fir::AbsentOp>(
 271                         loc, fir::BoxType::get(builder.getI1Type()))
 272                   : builder.createBox(loc, args[2]);
 273
 274   bool absentDim = isStaticallyAbsent(args[1]);
 275
 276   // For Maxval/MinVal, we call the type specific versions of
 277   // Maxval/Minval because the result is scalar in the case below.
 278   if (!hasCharacterResult && (absentDim || rank == 1))
 279     return func(builder, loc, array, mask);
 280
 281   if (hasCharacterResult && (absentDim || rank == 1)) {
 282     // Create mutable fir.box to be passed to the runtime for the result.
 283     fir::MutableBoxValue resultMutableBox =
 284         fir::factory::createTempMutableBox(builder, loc, resultType);
 285     mlir::Value resultIrBox =
 286         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
 287
 288     funcChar(builder, loc, resultIrBox, array, mask);
 289
 290     // Handle cleanup of allocatable result descriptor and return
 291     fir::ExtendedValue res =
 292         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
 293     return res.match(
 294         [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
 295           // Add cleanup code
 296           assert(stmtCtx);
 297           fir::FirOpBuilder *bldr = &builder;
 298           mlir::Value temp = box.getAddr();
 299           stmtCtx->attachCleanup(
 300               [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
 301           return box;
 302         },
 303         [&](const auto &) -> fir::ExtendedValue {
 304           fir::emitFatalError(loc, errMsg);
 305         });
 306   }
 307
 308   // Handle Min/Maxval cases that have an array result.
 309   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
 310                     args[1], mask, rank);
 311 }
 312
 313 /// Process calls to Minloc, Maxloc intrinsic functions
 314 template <typename FN, typename FD>
 315 static fir::ExtendedValue genExtremumloc(
 316     FN func, FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
 317     mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
 318     llvm::StringRef errMsg, llvm::ArrayRef<fir::ExtendedValue> args) {
 319
 320   assert(args.size() == 5);
 321
 322   // Handle required array argument
 323   mlir::Value array = builder.createBox(loc, args[0]);
 324   unsigned rank = fir::BoxValue(array).rank();
 325   assert(rank >= 1);
 326
 327   // Handle optional mask argument
 328   auto mask = isStaticallyAbsent(args[2])
 329                   ? builder.create<fir::AbsentOp>(
 330                         loc, fir::BoxType::get(builder.getI1Type()))
 331                   : builder.createBox(loc, args[2]);
 332
 333   // Handle optional kind argument
 334   auto kind = isStaticallyAbsent(args[3])
 335                   ? builder.createIntegerConstant(
 336                         loc, builder.getIndexType(),
 337                         builder.getKindMap().defaultIntegerKind())
 338                   : fir::getBase(args[3]);
 339
 340   // Handle optional back argument
 341   auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)
 342                                           : fir::getBase(args[4]);
 343
 344   bool absentDim = isStaticallyAbsent(args[1]);
 345
 346   if (!absentDim && rank == 1) {
 347     // If dim argument is present and the array is rank 1, then the result is
 348     // a scalar (since the the result is rank-1 or 0).
 349     // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
 350     mlir::Value dim = fir::getBase(args[1]);
 351     // Create mutable fir.box to be passed to the runtime for the result.
 352     fir::MutableBoxValue resultMutableBox =
 353         fir::factory::createTempMutableBox(builder, loc, resultType);
 354     mlir::Value resultIrBox =
 355         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
 356
 357     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
 358
 359     // Handle cleanup of allocatable result descriptor and return
 360     fir::ExtendedValue res =
 361         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
 362     return res.match(
 363         [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
 364           // Add cleanup code
 365           assert(stmtCtx);
 366           fir::FirOpBuilder *bldr = &builder;
 367           stmtCtx->attachCleanup(
 368               [=]() { bldr->create<fir::FreeMemOp>(loc, tempAddr); });
 369           return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
 370         },
 371         [&](const auto &) -> fir::ExtendedValue {
 372           fir::emitFatalError(loc, errMsg);
 373         });
 374   }
 375
 376   // Note: The Min/Maxloc/val cases below have an array result.
 377
 378   // Create mutable fir.box to be passed to the runtime for the result.
 379   mlir::Type resultArrayType =
 380       builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
 381   fir::MutableBoxValue resultMutableBox =
 382       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
 383   mlir::Value resultIrBox =
 384       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
 385
 386   if (absentDim) {
 387     // Handle min/maxloc/val case where there is no dim argument
 388     // (calls Min/Maxloc()/MinMaxval() runtime routine)
 389     func(builder, loc, resultIrBox, array, mask, kind, back);
 390   } else {
 391     // else handle min/maxloc case with dim argument (calls
 392     // Min/Max/loc/val/Dim() runtime routine).
 393     mlir::Value dim = fir::getBase(args[1]);
 394     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
 395   }
 396
 397   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
 398       .match(
 399           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
 400             // Add cleanup code
 401             assert(stmtCtx);
 402             fir::FirOpBuilder *bldr = &builder;
 403             mlir::Value temp = box.getAddr();
 404             stmtCtx->attachCleanup(
 405                 [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
 406             return box;
 407           },
 408           [&](const auto &) -> fir::ExtendedValue {
 409             fir::emitFatalError(loc, errMsg);
 410           });
 411 }
 412
 413 // TODO error handling -> return a code or directly emit messages ?
 414 struct IntrinsicLibrary {
 415
 416   // Constructors.
 417   explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc,
 418                             Fortran::lower::StatementContext *stmtCtx = nullptr)
 419       : builder{builder}, loc{loc}, stmtCtx{stmtCtx} {}
 420   IntrinsicLibrary() = delete;
 421   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
 422
 423   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
 424   /// and expected result type \p resultType.
 425   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
 426                                       llvm::Optional<mlir::Type> resultType,
 427                                       llvm::ArrayRef<fir::ExtendedValue> arg);
 428
 429   /// Search a runtime function that is associated to the generic intrinsic name
 430   /// and whose signature matches the intrinsic arguments and result types.
 431   /// If no such runtime function is found but a runtime function associated
 432   /// with the Fortran generic exists and has the same number of arguments,
 433   /// conversions will be inserted before and/or after the call. This is to
 434   /// mainly to allow 16 bits float support even-though little or no math
 435   /// runtime is currently available for it.
 436   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
 437                              llvm::ArrayRef<mlir::Value>);
 438
 439   using RuntimeCallGenerator = std::function<mlir::Value(
 440       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
 441   RuntimeCallGenerator
 442   getRuntimeCallGenerator(llvm::StringRef name,
 443                           mlir::FunctionType soughtFuncType);
 444
 445   void genAbort(llvm::ArrayRef<fir::ExtendedValue>);
 446
 447   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
 448   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
 449   /// if the argument is an integer, into llvm intrinsics if the argument is
 450   /// real and to the `hypot` math routine if the argument is of complex type.
 451   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
 452   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
 453                                 mlir::Value, mlir::Value)>
 454   fir::ExtendedValue genAdjustRtCall(mlir::Type,
 455                                      llvm::ArrayRef<fir::ExtendedValue>);
 456   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
 457   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
 458   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 459   fir::ExtendedValue genAllocated(mlir::Type,
 460                                   llvm::ArrayRef<fir::ExtendedValue>);
 461   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
 462   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 463   fir::ExtendedValue
 464       genCommandArgumentCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 465   fir::ExtendedValue genAssociated(mlir::Type,
 466                                    llvm::ArrayRef<fir::ExtendedValue>);
 467
 468   /// Lower a bitwise comparison intrinsic using the given comparator.
 469   template <mlir::arith::CmpIPredicate pred>
 470   mlir::Value genBitwiseCompare(mlir::Type resultType,
 471                                 llvm::ArrayRef<mlir::Value> args);
 472
 473   mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
 474   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
 475   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 476   template <mlir::arith::CmpIPredicate pred>
 477   fir::ExtendedValue genCharacterCompare(mlir::Type,
 478                                          llvm::ArrayRef<fir::ExtendedValue>);
 479   mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
 480   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
 481   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 482   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
 483   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 484   void genCFPointer(llvm::ArrayRef<fir::ExtendedValue>);
 485   fir::ExtendedValue genCFunLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 486   fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 487   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
 488   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
 489   fir::ExtendedValue genDotProduct(mlir::Type,
 490                                    llvm::ArrayRef<fir::ExtendedValue>);
 491   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
 492   mlir::Value genDshiftl(mlir::Type, llvm::ArrayRef<mlir::Value>);
 493   mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
 494   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 495   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
 496   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
 497   template <Extremum, ExtremumBehavior>
 498   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
 499   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
 500   mlir::Value genFraction(mlir::Type resultType,
 501                           mlir::ArrayRef<mlir::Value> args);
 502   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
 503   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
 504   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 505   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
 506   /// in the llvm::ArrayRef.
 507   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
 508   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 509   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
 510   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
 511   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
 512   fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 513   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
 514   template <mlir::arith::CmpIPredicate pred>
 515   fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
 516                                         llvm::ArrayRef<fir::ExtendedValue>);
 517   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
 518   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 519   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
 520   fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 521   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
 522   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
 523   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 524   mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
 525   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 526   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 527   template <typename Shift>
 528   mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>);
 529   fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 530   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 531   fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 532   fir::ExtendedValue genMerge(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 533   mlir::Value genMergeBits(mlir::Type, llvm::ArrayRef<mlir::Value>);
 534   fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 535   fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 536   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
 537   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
 538   void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
 539   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
 540   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
 541   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
 542   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 543   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 544   fir::ExtendedValue genParity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 545   mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>);
 546   mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
 547   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 548   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 549   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
 550   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
 551   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
 552   fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 553   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 554   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 555   mlir::Value genRRSpacing(mlir::Type resultType,
 556                            llvm::ArrayRef<mlir::Value> args);
 557   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
 558   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 559   mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
 560   mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
 561   mlir::Value genSetExponent(mlir::Type resultType,
 562                              llvm::ArrayRef<mlir::Value> args);
 563   template <typename Shift>
 564   mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
 565   mlir::Value genShiftA(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
 566   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
 567   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 568   mlir::Value genSpacing(mlir::Type resultType,
 569                          llvm::ArrayRef<mlir::Value> args);
 570   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 571   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 572   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
 573   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
 574   fir::ExtendedValue genTransfer(mlir::Type,
 575                                  llvm::ArrayRef<fir::ExtendedValue>);
 576   fir::ExtendedValue genTranspose(mlir::Type,
 577                                   llvm::ArrayRef<fir::ExtendedValue>);
 578   fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 579   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 580   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 581   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 582   /// Implement all conversion functions like DBLE, the first argument is
 583   /// the value to convert. There may be an additional KIND arguments that
 584   /// is ignored because this is already reflected in the result type.
 585   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
 586
 587   /// Define the different FIR generators that can be mapped to intrinsic to
 588   /// generate the related code.
 589   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
 590   using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
 591   using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime);
 592   using Generator =
 593       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
 594
 595   /// All generators can be outlined. This will build a function named
 596   /// "fir."+ <generic name> + "." + <result type code> and generate the
 597   /// intrinsic implementation inside instead of at the intrinsic call sites.
 598   /// This can be used to keep the FIR more readable. Only one function will
 599   /// be generated for all the similar calls in a program.
 600   /// If the Generator is nullptr, the wrapper uses genRuntimeCall.
 601   template <typename GeneratorType>
 602   mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name,
 603                                mlir::Type resultType,
 604                                llvm::ArrayRef<mlir::Value> args);
 605   template <typename GeneratorType>
 606   fir::ExtendedValue
 607   outlineInExtendedWrapper(GeneratorType, llvm::StringRef name,
 608                            llvm::Optional<mlir::Type> resultType,
 609                            llvm::ArrayRef<fir::ExtendedValue> args);
 610
 611   template <typename GeneratorType>
 612   mlir::func::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
 613                                 mlir::FunctionType,
 614                                 bool loadRefArguments = false);
 615
 616   /// Generate calls to ElementalGenerator, handling the elemental aspects
 617   template <typename GeneratorType>
 618   fir::ExtendedValue
 619   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
 620                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
 621
 622   /// Helper to invoke code generator for the intrinsics given arguments.
 623   mlir::Value invokeGenerator(ElementalGenerator generator,
 624                               mlir::Type resultType,
 625                               llvm::ArrayRef<mlir::Value> args);
 626   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
 627                               mlir::Type resultType,
 628                               llvm::ArrayRef<mlir::Value> args);
 629   mlir::Value invokeGenerator(ExtendedGenerator generator,
 630                               mlir::Type resultType,
 631                               llvm::ArrayRef<mlir::Value> args);
 632   mlir::Value invokeGenerator(SubroutineGenerator generator,
 633                               llvm::ArrayRef<mlir::Value> args);
 634
 635   /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
 636   /// intrinsic if it is not defined yet.
 637   mlir::SymbolRefAttr
 638   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
 639                                         mlir::FunctionType signature);
 640
 641   /// Add clean-up for \p temp to the current statement context;
 642   void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
 643   /// Helper function for generating code clean-up for result descriptors
 644   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
 645                                        mlir::Type resultType,
 646                                        llvm::StringRef errMsg);
 647
 648   fir::FirOpBuilder &builder;
 649   mlir::Location loc;
 650   Fortran::lower::StatementContext *stmtCtx;
 651 };
 652
 653 struct IntrinsicDummyArgument {
 654   const char *name = nullptr;
 655   Fortran::lower::LowerIntrinsicArgAs lowerAs =
 656       Fortran::lower::LowerIntrinsicArgAs::Value;
 657   bool handleDynamicOptional = false;
 658 };
 659
 660 /// This is shared by intrinsics and intrinsic module procedures.
 661 struct Fortran::lower::IntrinsicArgumentLoweringRules {
 662   /// There is no more than 7 non repeated arguments in Fortran intrinsics.
 663   IntrinsicDummyArgument args[7];
 664   constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
 665 };
 666
 667 /// Structure describing what needs to be done to lower intrinsic or intrinsic
 668 /// module procedure "name".
 669 struct IntrinsicHandler {
 670   const char *name;
 671   IntrinsicLibrary::Generator generator;
 672   // The following may be omitted in the table below.
 673   Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
 674   bool isElemental = true;
 675   /// Code heavy intrinsic can be outlined to make FIR
 676   /// more readable.
 677   bool outline = false;
 678 };
 679
 680 constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
 681 constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
 682 constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
 683 constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
 684 using I = IntrinsicLibrary;
 685
 686 /// Flag to indicate that an intrinsic argument has to be handled as
 687 /// being dynamically optional (e.g. special handling when actual
 688 /// argument is an optional variable in the current scope).
 689 static constexpr bool handleDynamicOptional = true;
 690
 691 /// Table that drives the fir generation depending on the intrinsic or intrinsic
 692 /// module procedure one to one mapping with Fortran arguments. If no mapping is
 693 /// defined here for a generic intrinsic, genRuntimeCall will be called
 694 /// to look for a match in the runtime a emit a call. Note that the argument
 695 /// lowering rules for an intrinsic need to be provided only if at least one
 696 /// argument must not be lowered by value. In which case, the lowering rules
 697 /// should be provided for all the intrinsic arguments for completeness.
 698 static constexpr IntrinsicHandler handlers[]{
 699     {"abort", &I::genAbort},
 700     {"abs", &I::genAbs},
 701     {"achar", &I::genChar},
 702     {"adjustl",
 703      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
 704      {{{"string", asAddr}}},
 705      /*isElemental=*/true},
 706     {"adjustr",
 707      &I::genAdjustRtCall<fir::runtime::genAdjustR>,
 708      {{{"string", asAddr}}},
 709      /*isElemental=*/true},
 710     {"aimag", &I::genAimag},
 711     {"aint", &I::genAint},
 712     {"all",
 713      &I::genAll,
 714      {{{"mask", asAddr}, {"dim", asValue}}},
 715      /*isElemental=*/false},
 716     {"allocated",
 717      &I::genAllocated,
 718      {{{"array", asInquired}, {"scalar", asInquired}}},
 719      /*isElemental=*/false},
 720     {"anint", &I::genAnint},
 721     {"any",
 722      &I::genAny,
 723      {{{"mask", asAddr}, {"dim", asValue}}},
 724      /*isElemental=*/false},
 725     {"associated",
 726      &I::genAssociated,
 727      {{{"pointer", asInquired}, {"target", asInquired}}},
 728      /*isElemental=*/false},
 729     {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
 730     {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
 731     {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
 732     {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
 733     {"btest", &I::genBtest},
 734     {"c_f_pointer",
 735      &I::genCFPointer,
 736      {{{"cptr", asValue},
 737        {"fptr", asInquired},
 738        {"shape", asAddr, handleDynamicOptional}}},
 739      /*isElemental=*/false},
 740     {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},
 741     {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
 742     {"ceiling", &I::genCeiling},
 743     {"char", &I::genChar},
 744     {"cmplx",
 745      &I::genCmplx,
 746      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
 747     {"command_argument_count", &I::genCommandArgumentCount},
 748     {"conjg", &I::genConjg},
 749     {"count",
 750      &I::genCount,
 751      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
 752      /*isElemental=*/false},
 753     {"cpu_time",
 754      &I::genCpuTime,
 755      {{{"time", asAddr}}},
 756      /*isElemental=*/false},
 757     {"cshift",
 758      &I::genCshift,
 759      {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
 760      /*isElemental=*/false},
 761     {"date_and_time",
 762      &I::genDateAndTime,
 763      {{{"date", asAddr, handleDynamicOptional},
 764        {"time", asAddr, handleDynamicOptional},
 765        {"zone", asAddr, handleDynamicOptional},
 766        {"values", asBox, handleDynamicOptional}}},
 767      /*isElemental=*/false},
 768     {"dble", &I::genConversion},
 769     {"dim", &I::genDim},
 770     {"dot_product",
 771      &I::genDotProduct,
 772      {{{"vector_a", asBox}, {"vector_b", asBox}}},
 773      /*isElemental=*/false},
 774     {"dprod", &I::genDprod},
 775     {"dshiftl", &I::genDshiftl},
 776     {"dshiftr", &I::genDshiftr},
 777     {"eoshift",
 778      &I::genEoshift,
 779      {{{"array", asBox},
 780        {"shift", asAddr},
 781        {"boundary", asBox, handleDynamicOptional},
 782        {"dim", asValue}}},
 783      /*isElemental=*/false},
 784     {"exit",
 785      &I::genExit,
 786      {{{"status", asValue, handleDynamicOptional}}},
 787      /*isElemental=*/false},
 788     {"exponent", &I::genExponent},
 789     {"floor", &I::genFloor},
 790     {"fraction", &I::genFraction},
 791     {"get_command_argument",
 792      &I::genGetCommandArgument,
 793      {{{"number", asValue},
 794        {"value", asBox, handleDynamicOptional},
 795        {"length", asBox, handleDynamicOptional},
 796        {"status", asAddr, handleDynamicOptional},
 797        {"errmsg", asBox, handleDynamicOptional}}},
 798      /*isElemental=*/false},
 799     {"get_environment_variable",
 800      &I::genGetEnvironmentVariable,
 801      {{{"name", asBox},
 802        {"value", asBox, handleDynamicOptional},
 803        {"length", asAddr},
 804        {"status", asAddr},
 805        {"trim_name", asAddr},
 806        {"errmsg", asBox, handleDynamicOptional}}},
 807      /*isElemental=*/false},
 808     {"iachar", &I::genIchar},
 809     {"iall",
 810      &I::genIall,
 811      {{{"array", asBox},
 812        {"dim", asValue},
 813        {"mask", asBox, handleDynamicOptional}}},
 814      /*isElemental=*/false},
 815     {"iand", &I::genIand},
 816     {"iany",
 817      &I::genIany,
 818      {{{"array", asBox},
 819        {"dim", asValue},
 820        {"mask", asBox, handleDynamicOptional}}},
 821      /*isElemental=*/false},
 822     {"ibclr", &I::genIbclr},
 823     {"ibits", &I::genIbits},
 824     {"ibset", &I::genIbset},
 825     {"ichar", &I::genIchar},
 826     {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
 827     {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
 828     {"ieee_is_finite", &I::genIeeeIsFinite},
 829     {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
 830     {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
 831     {"ieor", &I::genIeor},
 832     {"index",
 833      &I::genIndex,
 834      {{{"string", asAddr},
 835        {"substring", asAddr},
 836        {"back", asValue, handleDynamicOptional},
 837        {"kind", asValue}}}},
 838     {"ior", &I::genIor},
 839     {"iparity",
 840      &I::genIparity,
 841      {{{"array", asBox},
 842        {"dim", asValue},
 843        {"mask", asBox, handleDynamicOptional}}},
 844      /*isElemental=*/false},
 845     {"ishft", &I::genIshft},
 846     {"ishftc", &I::genIshftc},
 847     {"lbound",
 848      &I::genLbound,
 849      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
 850      /*isElemental=*/false},
 851     {"leadz", &I::genLeadz},
 852     {"len",
 853      &I::genLen,
 854      {{{"string", asInquired}, {"kind", asValue}}},
 855      /*isElemental=*/false},
 856     {"len_trim", &I::genLenTrim},
 857     {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
 858     {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
 859     {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
 860     {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
 861     {"maskl", &I::genMask<mlir::arith::ShLIOp>},
 862     {"maskr", &I::genMask<mlir::arith::ShRUIOp>},
 863     {"matmul",
 864      &I::genMatmul,
 865      {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
 866      /*isElemental=*/false},
 867     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
 868     {"maxloc",
 869      &I::genMaxloc,
 870      {{{"array", asBox},
 871        {"dim", asValue},
 872        {"mask", asBox, handleDynamicOptional},
 873        {"kind", asValue},
 874        {"back", asValue, handleDynamicOptional}}},
 875      /*isElemental=*/false},
 876     {"maxval",
 877      &I::genMaxval,
 878      {{{"array", asBox},
 879        {"dim", asValue},
 880        {"mask", asBox, handleDynamicOptional}}},
 881      /*isElemental=*/false},
 882     {"merge", &I::genMerge},
 883     {"merge_bits", &I::genMergeBits},
 884     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
 885     {"minloc",
 886      &I::genMinloc,
 887      {{{"array", asBox},
 888        {"dim", asValue},
 889        {"mask", asBox, handleDynamicOptional},
 890        {"kind", asValue},
 891        {"back", asValue, handleDynamicOptional}}},
 892      /*isElemental=*/false},
 893     {"minval",
 894      &I::genMinval,
 895      {{{"array", asBox},
 896        {"dim", asValue},
 897        {"mask", asBox, handleDynamicOptional}}},
 898      /*isElemental=*/false},
 899     {"mod", &I::genMod},
 900     {"modulo", &I::genModulo},
 901     {"mvbits",
 902      &I::genMvbits,
 903      {{{"from", asValue},
 904        {"frompos", asValue},
 905        {"len", asValue},
 906        {"to", asAddr},
 907        {"topos", asValue}}}},
 908     {"nearest", &I::genNearest},
 909     {"nint", &I::genNint},
 910     {"not", &I::genNot},
 911     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
 912     {"pack",
 913      &I::genPack,
 914      {{{"array", asBox},
 915        {"mask", asBox},
 916        {"vector", asBox, handleDynamicOptional}}},
 917      /*isElemental=*/false},
 918     {"parity",
 919      &I::genParity,
 920      {{{"mask", asBox}, {"dim", asValue}}},
 921      /*isElemental=*/false},
 922     {"popcnt", &I::genPopcnt},
 923     {"poppar", &I::genPoppar},
 924     {"present",
 925      &I::genPresent,
 926      {{{"a", asInquired}}},
 927      /*isElemental=*/false},
 928     {"product",
 929      &I::genProduct,
 930      {{{"array", asBox},
 931        {"dim", asValue},
 932        {"mask", asBox, handleDynamicOptional}}},
 933      /*isElemental=*/false},
 934     {"random_init",
 935      &I::genRandomInit,
 936      {{{"repeatable", asValue}, {"image_distinct", asValue}}},
 937      /*isElemental=*/false},
 938     {"random_number",
 939      &I::genRandomNumber,
 940      {{{"harvest", asBox}}},
 941      /*isElemental=*/false},
 942     {"random_seed",
 943      &I::genRandomSeed,
 944      {{{"size", asBox, handleDynamicOptional},
 945        {"put", asBox, handleDynamicOptional},
 946        {"get", asBox, handleDynamicOptional}}},
 947      /*isElemental=*/false},
 948     {"reduce",
 949      &I::genReduce,
 950      {{{"array", asBox},
 951        {"operation", asAddr},
 952        {"dim", asValue},
 953        {"mask", asBox, handleDynamicOptional},
 954        {"identity", asValue},
 955        {"ordered", asValue}}},
 956      /*isElemental=*/false},
 957     {"repeat",
 958      &I::genRepeat,
 959      {{{"string", asAddr}, {"ncopies", asValue}}},
 960      /*isElemental=*/false},
 961     {"reshape",
 962      &I::genReshape,
 963      {{{"source", asBox},
 964        {"shape", asBox},
 965        {"pad", asBox, handleDynamicOptional},
 966        {"order", asBox, handleDynamicOptional}}},
 967      /*isElemental=*/false},
 968     {"rrspacing", &I::genRRSpacing},
 969     {"scale",
 970      &I::genScale,
 971      {{{"x", asValue}, {"i", asValue}}},
 972      /*isElemental=*/true},
 973     {"scan",
 974      &I::genScan,
 975      {{{"string", asAddr},
 976        {"set", asAddr},
 977        {"back", asValue, handleDynamicOptional},
 978        {"kind", asValue}}},
 979      /*isElemental=*/true},
 980     {"selected_int_kind",
 981      &I::genSelectedIntKind,
 982      {{{"scalar", asAddr}}},
 983      /*isElemental=*/false},
 984     {"selected_real_kind",
 985      &I::genSelectedRealKind,
 986      {{{"precision", asAddr, handleDynamicOptional},
 987        {"range", asAddr, handleDynamicOptional},
 988        {"radix", asAddr, handleDynamicOptional}}},
 989      /*isElemental=*/false},
 990     {"set_exponent", &I::genSetExponent},
 991     {"shifta", &I::genShiftA},
 992     {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
 993     {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
 994     {"sign", &I::genSign},
 995     {"size",
 996      &I::genSize,
 997      {{{"array", asBox},
 998        {"dim", asAddr, handleDynamicOptional},
 999        {"kind", asValue}}},
1000      /*isElemental=*/false},
1001     {"spacing", &I::genSpacing},
1002     {"spread",
1003      &I::genSpread,
1004      {{{"source", asAddr}, {"dim", asValue}, {"ncopies", asValue}}},
1005      /*isElemental=*/false},
1006     {"sum",
1007      &I::genSum,
1008      {{{"array", asBox},
1009        {"dim", asValue},
1010        {"mask", asBox, handleDynamicOptional}}},
1011      /*isElemental=*/false},
1012     {"system_clock",
1013      &I::genSystemClock,
1014      {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
1015      /*isElemental=*/false},
1016     {"trailz", &I::genTrailz},
1017     {"transfer",
1018      &I::genTransfer,
1019      {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
1020      /*isElemental=*/false},
1021     {"transpose",
1022      &I::genTranspose,
1023      {{{"matrix", asAddr}}},
1024      /*isElemental=*/false},
1025     {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
1026     {"ubound",
1027      &I::genUbound,
1028      {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
1029      /*isElemental=*/false},
1030     {"unpack",
1031      &I::genUnpack,
1032      {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
1033      /*isElemental=*/false},
1034     {"verify",
1035      &I::genVerify,
1036      {{{"string", asAddr},
1037        {"set", asAddr},
1038        {"back", asValue, handleDynamicOptional},
1039        {"kind", asValue}}},
1040      /*isElemental=*/true},
1041 };
1042
1043 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
1044   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
1045     return name.compare(handler.name) > 0;
1046   };
1047   auto result = llvm::lower_bound(handlers, name, compare);
1048   return result != std::end(handlers) && result->name == name ? result
1049                                                               : nullptr;
1050 }
1051
1052 /// To make fir output more readable for debug, one can outline all intrinsic
1053 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
1054 static llvm::cl::opt<bool> outlineAllIntrinsics(
1055     "outline-intrinsics",
1056     llvm::cl::desc(
1057         "Lower all intrinsic procedure implementation in their own functions"),
1058     llvm::cl::init(false));
1059
1060 //===----------------------------------------------------------------------===//
1061 // Math runtime description and matching utility
1062 //===----------------------------------------------------------------------===//
1063
1064 /// Command line option to modify math runtime behavior used to implement
1065 /// intrinsics. This option applies both to early and late math-lowering modes.
1066 enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion };
1067 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
1068     "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),
1069     llvm::cl::values(
1070         clEnumValN(fastVersion, "fast", "use fast runtime behavior"),
1071         clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),
1072         clEnumValN(preciseVersion, "precise", "use precise runtime behavior")),
1073     llvm::cl::init(fastVersion));
1074
1075 struct RuntimeFunction {
1076   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1077   using Key = std::string_view;
1078   // Needed for implicit compare with keys.
1079   constexpr operator Key() const { return key; }
1080   Key key; // intrinsic name
1081
1082   // Name of a runtime function that implements the operation.
1083   llvm::StringRef symbol;
1084   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1085 };
1086
1087 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
1088   {#name, #func, fir::runtime::RuntimeTableKey<decltype(func)>::getTypeModel()},
1089 static constexpr RuntimeFunction pgmathFast[] = {
1090 #define PGMATH_FAST
1091 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1092 #include "flang/Evaluate/pgmath.h.inc"
1093 };
1094 static constexpr RuntimeFunction pgmathRelaxed[] = {
1095 #define PGMATH_RELAXED
1096 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1097 #include "flang/Evaluate/pgmath.h.inc"
1098 };
1099 static constexpr RuntimeFunction pgmathPrecise[] = {
1100 #define PGMATH_PRECISE
1101 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1102 #include "flang/Evaluate/pgmath.h.inc"
1103 };
1104
1105 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
1106   mlir::Type t = mlir::FloatType::getF32(context);
1107   return mlir::FunctionType::get(context, {t}, {t});
1108 }
1109
1110 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
1111   mlir::Type t = mlir::FloatType::getF64(context);
1112   return mlir::FunctionType::get(context, {t}, {t});
1113 }
1114
1115 static mlir::FunctionType genF80F80FuncType(mlir::MLIRContext *context) {
1116   mlir::Type t = mlir::FloatType::getF80(context);
1117   return mlir::FunctionType::get(context, {t}, {t});
1118 }
1119
1120 static mlir::FunctionType genF128F128FuncType(mlir::MLIRContext *context) {
1121   mlir::Type t = mlir::FloatType::getF128(context);
1122   return mlir::FunctionType::get(context, {t}, {t});
1123 }
1124
1125 static mlir::FunctionType genF32F32F32FuncType(mlir::MLIRContext *context) {
1126   auto t = mlir::FloatType::getF32(context);
1127   return mlir::FunctionType::get(context, {t, t}, {t});
1128 }
1129
1130 static mlir::FunctionType genF64F64F64FuncType(mlir::MLIRContext *context) {
1131   auto t = mlir::FloatType::getF64(context);
1132   return mlir::FunctionType::get(context, {t, t}, {t});
1133 }
1134
1135 static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) {
1136   auto t = mlir::FloatType::getF80(context);
1137   return mlir::FunctionType::get(context, {t, t}, {t});
1138 }
1139
1140 static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) {
1141   auto t = mlir::FloatType::getF128(context);
1142   return mlir::FunctionType::get(context, {t, t}, {t});
1143 }
1144
1145 template <int Bits>
1146 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
1147   auto t = mlir::FloatType::getF64(context);
1148   auto r = mlir::IntegerType::get(context, Bits);
1149   return mlir::FunctionType::get(context, {t}, {r});
1150 }
1151
1152 template <int Bits>
1153 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
1154   auto t = mlir::FloatType::getF32(context);
1155   auto r = mlir::IntegerType::get(context, Bits);
1156   return mlir::FunctionType::get(context, {t}, {r});
1157 }
1158
1159 template <int Bits>
1160 static mlir::FunctionType genF64F64IntFuncType(mlir::MLIRContext *context) {
1161   auto ftype = mlir::FloatType::getF64(context);
1162   auto itype = mlir::IntegerType::get(context, Bits);
1163   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1164 }
1165
1166 template <int Bits>
1167 static mlir::FunctionType genF32F32IntFuncType(mlir::MLIRContext *context) {
1168   auto ftype = mlir::FloatType::getF32(context);
1169   auto itype = mlir::IntegerType::get(context, Bits);
1170   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1171 }
1172
1173 template <int Bits>
1174 static mlir::FunctionType genF64IntF64FuncType(mlir::MLIRContext *context) {
1175   auto ftype = mlir::FloatType::getF64(context);
1176   auto itype = mlir::IntegerType::get(context, Bits);
1177   return mlir::FunctionType::get(context, {itype, ftype}, {ftype});
1178 }
1179
1180 template <int Bits>
1181 static mlir::FunctionType genF32IntF32FuncType(mlir::MLIRContext *context) {
1182   auto ftype = mlir::FloatType::getF32(context);
1183   auto itype = mlir::IntegerType::get(context, Bits);
1184   return mlir::FunctionType::get(context, {itype, ftype}, {ftype});
1185 }
1186
1187 template <int Bits>
1188 static mlir::FunctionType genIntIntIntFuncType(mlir::MLIRContext *context) {
1189   auto itype = mlir::IntegerType::get(context, Bits);
1190   return mlir::FunctionType::get(context, {itype, itype}, {itype});
1191 }
1192
1193 template <int Kind>
1194 static mlir::FunctionType
1195 genComplexComplexFuncType(mlir::MLIRContext *context) {
1196   auto ctype = fir::ComplexType::get(context, Kind);
1197   return mlir::FunctionType::get(context, {ctype}, {ctype});
1198 }
1199
1200 template <int Kind>
1201 static mlir::FunctionType
1202 genComplexComplexComplexFuncType(mlir::MLIRContext *context) {
1203   auto ctype = fir::ComplexType::get(context, Kind);
1204   return mlir::FunctionType::get(context, {ctype, ctype}, {ctype});
1205 }
1206
1207 static mlir::FunctionType genF32ComplexFuncType(mlir::MLIRContext *context) {
1208   auto ctype = fir::ComplexType::get(context, 4);
1209   auto ftype = mlir::FloatType::getF32(context);
1210   return mlir::FunctionType::get(context, {ctype}, {ftype});
1211 }
1212
1213 static mlir::FunctionType genF64ComplexFuncType(mlir::MLIRContext *context) {
1214   auto ctype = fir::ComplexType::get(context, 8);
1215   auto ftype = mlir::FloatType::getF64(context);
1216   return mlir::FunctionType::get(context, {ctype}, {ftype});
1217 }
1218
1219 template <int Kind, int Bits>
1220 static mlir::FunctionType
1221 genComplexComplexIntFuncType(mlir::MLIRContext *context) {
1222   auto ctype = fir::ComplexType::get(context, Kind);
1223   auto itype = mlir::IntegerType::get(context, Bits);
1224   return mlir::FunctionType::get(context, {ctype, itype}, {ctype});
1225 }
1226
1227 /// Callback type for generating lowering for a math operation.
1228 using MathGeneratorTy = mlir::Value (*)(fir::FirOpBuilder &, mlir::Location,
1229                                         llvm::StringRef, mlir::FunctionType,
1230                                         llvm::ArrayRef<mlir::Value>);
1231
1232 struct MathOperation {
1233   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1234   using Key = std::string_view;
1235   // Needed for implicit compare with keys.
1236   constexpr operator Key() const { return key; }
1237   // Intrinsic name.
1238   Key key;
1239
1240   // Name of a runtime function that implements the operation.
1241   llvm::StringRef runtimeFunc;
1242   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1243
1244   // A callback to generate FIR for the intrinsic defined by 'key'.
1245   // A callback may generate either dedicated MLIR operation(s) or
1246   // a function call to a runtime function with name defined by
1247   // 'runtimeFunc'.
1248   MathGeneratorTy funcGenerator;
1249 };
1250
1251 static mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,
1252                               llvm::StringRef libFuncName,
1253                               mlir::FunctionType libFuncType,
1254                               llvm::ArrayRef<mlir::Value> args) {
1255   LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName
1256                           << "' call with type ";
1257              libFuncType.dump(); llvm::dbgs() << "\n");
1258   mlir::func::FuncOp funcOp =
1259       builder.addNamedFunction(loc, libFuncName, libFuncType);
1260   // TODO: ensure 'strictfp' setting on the call for "precise/strict"
1261   //       FP mode. Set appropriate Fast-Math Flags otherwise.
1262   // TODO: we should also mark as many libm function as possible
1263   //       with 'pure' attribute (of course, not in strict FP mode).
1264   auto libCall = builder.create<fir::CallOp>(loc, funcOp, args);
1265   LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
1266   return libCall.getResult(0);
1267 }
1268
1269 template <typename T>
1270 static mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
1271                              llvm::StringRef mathLibFuncName,
1272                              mlir::FunctionType mathLibFuncType,
1273                              llvm::ArrayRef<mlir::Value> args) {
1274   // TODO: we have to annotate the math operations with flags
1275   //       that will allow to define FP accuracy/exception
1276   //       behavior per operation, so that after early multi-module
1277   //       MLIR inlining we can distiguish operation that were
1278   //       compiled with different settings.
1279   //       Suggestion:
1280   //         * For "relaxed" FP mode set all Fast-Math Flags
1281   //           (see "[RFC] FastMath flags support in MLIR (arith dialect)"
1282   //           topic at discourse.llvm.org).
1283   //         * For "fast" FP mode set all Fast-Math Flags except 'afn'.
1284   //         * For "precise/strict" FP mode generate fir.calls to libm
1285   //           entries and annotate them with an attribute that will
1286   //           end up transformed into 'strictfp' LLVM attribute (TBD).
1287   //           Elsewhere, "precise/strict" FP mode should also set
1288   //           'strictfp' for all user functions and calls so that
1289   //           LLVM backend does the right job.
1290   //         * Operations that cannot be reasonably optimized in MLIR
1291   //           can be also lowered to libm calls for "fast" and "relaxed"
1292   //           modes.
1293   mlir::Value result;
1294   if (mathRuntimeVersion == preciseVersion &&
1295       // Some operations do not have to be lowered as conservative
1296       // calls, since they do not affect strict FP behavior.
1297       // For example, purely integer operations like exponentiation
1298       // with integer operands fall into this class.
1299       !mathLibFuncName.empty()) {
1300     result = genLibCall(builder, loc, mathLibFuncName, mathLibFuncType, args);
1301   } else {
1302     LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
1303                             << "' operation with type ";
1304                mathLibFuncType.dump(); llvm::dbgs() << "\n");
1305     result = builder.create<T>(loc, args);
1306   }
1307   LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1308   return result;
1309 }
1310
1311 /// Mapping between mathematical intrinsic operations and MLIR operations
1312 /// of some appropriate dialect (math, complex, etc.) or libm calls.
1313 /// TODO: support remaining Fortran math intrinsics.
1314 ///       See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\
1315 ///       Intrinsic-Procedures.html for a reference.
1316 static constexpr MathOperation mathOperations[] = {
1317     {"abs", "fabsf", genF32F32FuncType, genMathOp<mlir::math::AbsFOp>},
1318     {"abs", "fabs", genF64F64FuncType, genMathOp<mlir::math::AbsFOp>},
1319     {"abs", "llvm.fabs.f128", genF128F128FuncType,
1320      genMathOp<mlir::math::AbsFOp>},
1321     {"abs", "cabsf", genF32ComplexFuncType, genLibCall},
1322     {"abs", "cabs", genF64ComplexFuncType, genLibCall},
1323     {"acos", "acosf", genF32F32FuncType, genLibCall},
1324     {"acos", "acos", genF64F64FuncType, genLibCall},
1325     {"acos", "cacosf", genComplexComplexFuncType<4>, genLibCall},
1326     {"acos", "cacos", genComplexComplexFuncType<8>, genLibCall},
1327     {"acosh", "acoshf", genF32F32FuncType, genLibCall},
1328     {"acosh", "acosh", genF64F64FuncType, genLibCall},
1329     {"acosh", "cacoshf", genComplexComplexFuncType<4>, genLibCall},
1330     {"acosh", "cacosh", genComplexComplexFuncType<8>, genLibCall},
1331     // llvm.trunc behaves the same way as libm's trunc.
1332     {"aint", "llvm.trunc.f32", genF32F32FuncType, genLibCall},
1333     {"aint", "llvm.trunc.f64", genF64F64FuncType, genLibCall},
1334     {"aint", "llvm.trunc.f80", genF80F80FuncType, genLibCall},
1335     // llvm.round behaves the same way as libm's round.
1336     {"anint", "llvm.round.f32", genF32F32FuncType,
1337      genMathOp<mlir::LLVM::RoundOp>},
1338     {"anint", "llvm.round.f64", genF64F64FuncType,
1339      genMathOp<mlir::LLVM::RoundOp>},
1340     {"anint", "llvm.round.f80", genF80F80FuncType,
1341      genMathOp<mlir::LLVM::RoundOp>},
1342     {"asin", "asinf", genF32F32FuncType, genLibCall},
1343     {"asin", "asin", genF64F64FuncType, genLibCall},
1344     {"asin", "casinf", genComplexComplexFuncType<4>, genLibCall},
1345     {"asin", "casin", genComplexComplexFuncType<8>, genLibCall},
1346     {"asinh", "asinhf", genF32F32FuncType, genLibCall},
1347     {"asinh", "asinh", genF64F64FuncType, genLibCall},
1348     {"asinh", "casinhf", genComplexComplexFuncType<4>, genLibCall},
1349     {"asinh", "casinh", genComplexComplexFuncType<8>, genLibCall},
1350     {"atan", "atanf", genF32F32FuncType, genMathOp<mlir::math::AtanOp>},
1351     {"atan", "atan", genF64F64FuncType, genMathOp<mlir::math::AtanOp>},
1352     {"atan", "catanf", genComplexComplexFuncType<4>, genLibCall},
1353     {"atan", "catan", genComplexComplexFuncType<8>, genLibCall},
1354     {"atan2", "atan2f", genF32F32F32FuncType, genMathOp<mlir::math::Atan2Op>},
1355     {"atan2", "atan2", genF64F64F64FuncType, genMathOp<mlir::math::Atan2Op>},
1356     {"atanh", "atanhf", genF32F32FuncType, genLibCall},
1357     {"atanh", "atanh", genF64F64FuncType, genLibCall},
1358     {"atanh", "catanhf", genComplexComplexFuncType<4>, genLibCall},
1359     {"atanh", "catanh", genComplexComplexFuncType<8>, genLibCall},
1360     {"bessel_j0", "j0f", genF32F32FuncType, genLibCall},
1361     {"bessel_j0", "j0", genF64F64FuncType, genLibCall},
1362     {"bessel_j1", "j1f", genF32F32FuncType, genLibCall},
1363     {"bessel_j1", "j1", genF64F64FuncType, genLibCall},
1364     {"bessel_jn", "jnf", genF32IntF32FuncType<32>, genLibCall},
1365     {"bessel_jn", "jn", genF64IntF64FuncType<32>, genLibCall},
1366     {"bessel_y0", "y0f", genF32F32FuncType, genLibCall},
1367     {"bessel_y0", "y0", genF64F64FuncType, genLibCall},
1368     {"bessel_y1", "y1f", genF32F32FuncType, genLibCall},
1369     {"bessel_y1", "y1", genF64F64FuncType, genLibCall},
1370     {"bessel_yn", "ynf", genF32IntF32FuncType<32>, genLibCall},
1371     {"bessel_yn", "yn", genF64IntF64FuncType<32>, genLibCall},
1372     // math::CeilOp returns a real, while Fortran CEILING returns integer.
1373     {"ceil", "ceilf", genF32F32FuncType, genMathOp<mlir::math::CeilOp>},
1374     {"ceil", "ceil", genF64F64FuncType, genMathOp<mlir::math::CeilOp>},
1375     {"cos", "cosf", genF32F32FuncType, genMathOp<mlir::math::CosOp>},
1376     {"cos", "cos", genF64F64FuncType, genMathOp<mlir::math::CosOp>},
1377     {"cos", "ccosf", genComplexComplexFuncType<4>, genLibCall},
1378     {"cos", "ccos", genComplexComplexFuncType<8>, genLibCall},
1379     {"cosh", "coshf", genF32F32FuncType, genLibCall},
1380     {"cosh", "cosh", genF64F64FuncType, genLibCall},
1381     {"cosh", "ccoshf", genComplexComplexFuncType<4>, genLibCall},
1382     {"cosh", "ccosh", genComplexComplexFuncType<8>, genLibCall},
1383     {"erf", "erff", genF32F32FuncType, genMathOp<mlir::math::ErfOp>},
1384     {"erf", "erf", genF64F64FuncType, genMathOp<mlir::math::ErfOp>},
1385     {"erfc", "erfcf", genF32F32FuncType, genLibCall},
1386     {"erfc", "erfc", genF64F64FuncType, genLibCall},
1387     {"exp", "expf", genF32F32FuncType, genMathOp<mlir::math::ExpOp>},
1388     {"exp", "exp", genF64F64FuncType, genMathOp<mlir::math::ExpOp>},
1389     {"exp", "cexpf", genComplexComplexFuncType<4>, genLibCall},
1390     {"exp", "cexp", genComplexComplexFuncType<8>, genLibCall},
1391     // math::FloorOp returns a real, while Fortran FLOOR returns integer.
1392     {"floor", "floorf", genF32F32FuncType, genMathOp<mlir::math::FloorOp>},
1393     {"floor", "floor", genF64F64FuncType, genMathOp<mlir::math::FloorOp>},
1394     {"gamma", "tgammaf", genF32F32FuncType, genLibCall},
1395     {"gamma", "tgamma", genF64F64FuncType, genLibCall},
1396     {"hypot", "hypotf", genF32F32F32FuncType, genLibCall},
1397     {"hypot", "hypot", genF64F64F64FuncType, genLibCall},
1398     {"log", "logf", genF32F32FuncType, genMathOp<mlir::math::LogOp>},
1399     {"log", "log", genF64F64FuncType, genMathOp<mlir::math::LogOp>},
1400     {"log", "clogf", genComplexComplexFuncType<4>, genLibCall},
1401     {"log", "clog", genComplexComplexFuncType<8>, genLibCall},
1402     {"log10", "log10f", genF32F32FuncType, genMathOp<mlir::math::Log10Op>},
1403     {"log10", "log10", genF64F64FuncType, genMathOp<mlir::math::Log10Op>},
1404     {"log_gamma", "lgammaf", genF32F32FuncType, genLibCall},
1405     {"log_gamma", "lgamma", genF64F64FuncType, genLibCall},
1406     // llvm.lround behaves the same way as libm's lround.
1407     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>, genLibCall},
1408     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>, genLibCall},
1409     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>, genLibCall},
1410     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>, genLibCall},
1411     {"pow", {}, genIntIntIntFuncType<8>, genMathOp<mlir::math::IPowIOp>},
1412     {"pow", {}, genIntIntIntFuncType<16>, genMathOp<mlir::math::IPowIOp>},
1413     {"pow", {}, genIntIntIntFuncType<32>, genMathOp<mlir::math::IPowIOp>},
1414     {"pow", {}, genIntIntIntFuncType<64>, genMathOp<mlir::math::IPowIOp>},
1415     {"pow", "powf", genF32F32F32FuncType, genMathOp<mlir::math::PowFOp>},
1416     {"pow", "pow", genF64F64F64FuncType, genMathOp<mlir::math::PowFOp>},
1417     {"pow", "cpowf", genComplexComplexComplexFuncType<4>, genLibCall},
1418     {"pow", "cpow", genComplexComplexComplexFuncType<8>, genLibCall},
1419     // TODO: add PowIOp in math and complex dialects.
1420     {"pow", "llvm.powi.f32.i32", genF32F32IntFuncType<32>, genLibCall},
1421     {"pow", "llvm.powi.f64.i32", genF64F64IntFuncType<32>, genLibCall},
1422     {"pow", RTNAME_STRING(cpowi), genComplexComplexIntFuncType<4, 32>,
1423      genLibCall},
1424     {"pow", RTNAME_STRING(zpowi), genComplexComplexIntFuncType<8, 32>,
1425      genLibCall},
1426     {"pow", RTNAME_STRING(cpowk), genComplexComplexIntFuncType<4, 64>,
1427      genLibCall},
1428     {"pow", RTNAME_STRING(zpowk), genComplexComplexIntFuncType<8, 64>,
1429      genLibCall},
1430     {"sign", "copysignf", genF32F32F32FuncType,
1431      genMathOp<mlir::math::CopySignOp>},
1432     {"sign", "copysign", genF64F64F64FuncType,
1433      genMathOp<mlir::math::CopySignOp>},
1434     {"sign", "copysignl", genF80F80F80FuncType,
1435      genMathOp<mlir::math::CopySignOp>},
1436     {"sign", "llvm.copysign.f128", genF128F128F128FuncType,
1437      genMathOp<mlir::math::CopySignOp>},
1438     {"sin", "sinf", genF32F32FuncType, genMathOp<mlir::math::SinOp>},
1439     {"sin", "sin", genF64F64FuncType, genMathOp<mlir::math::SinOp>},
1440     {"sin", "csinf", genComplexComplexFuncType<4>, genLibCall},
1441     {"sin", "csin", genComplexComplexFuncType<8>, genLibCall},
1442     {"sinh", "sinhf", genF32F32FuncType, genLibCall},
1443     {"sinh", "sinh", genF64F64FuncType, genLibCall},
1444     {"sinh", "csinhf", genComplexComplexFuncType<4>, genLibCall},
1445     {"sinh", "csinh", genComplexComplexFuncType<8>, genLibCall},
1446     {"sqrt", "sqrtf", genF32F32FuncType, genMathOp<mlir::math::SqrtOp>},
1447     {"sqrt", "sqrt", genF64F64FuncType, genMathOp<mlir::math::SqrtOp>},
1448     {"sqrt", "csqrtf", genComplexComplexFuncType<4>, genLibCall},
1449     {"sqrt", "csqrt", genComplexComplexFuncType<8>, genLibCall},
1450     {"tan", "tanf", genF32F32FuncType, genMathOp<mlir::math::TanOp>},
1451     {"tan", "tan", genF64F64FuncType, genMathOp<mlir::math::TanOp>},
1452     {"tan", "ctanf", genComplexComplexFuncType<4>, genLibCall},
1453     {"tan", "ctan", genComplexComplexFuncType<8>, genLibCall},
1454     {"tanh", "tanhf", genF32F32FuncType, genMathOp<mlir::math::TanhOp>},
1455     {"tanh", "tanh", genF64F64FuncType, genMathOp<mlir::math::TanhOp>},
1456     {"tanh", "ctanhf", genComplexComplexFuncType<4>, genLibCall},
1457     {"tanh", "ctanh", genComplexComplexFuncType<8>, genLibCall},
1458 };
1459
1460 // This helper class computes a "distance" between two function types.
1461 // The distance measures how many narrowing conversions of actual arguments
1462 // and result of "from" must be made in order to use "to" instead of "from".
1463 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1464 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1465 // if no implementation of ACOS(REAL(10)) is available, it is better to use
1466 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1467 // Note that this is not a symmetric distance and the order of "from" and "to"
1468 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1469 // may be safe to replace foo by bar, but not the opposite.
1470 class FunctionDistance {
1471 public:
1472   FunctionDistance() : infinite{true} {}
1473
1474   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1475     unsigned nInputs = from.getNumInputs();
1476     unsigned nResults = from.getNumResults();
1477     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1478       infinite = true;
1479     } else {
1480       for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1481         addArgumentDistance(from.getInput(i), to.getInput(i));
1482       for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1483         addResultDistance(to.getResult(i), from.getResult(i));
1484     }
1485   }
1486
1487   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1488   /// false if both d1 and d2 are infinite. This implies that
1489   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1490   bool isSmallerThan(const FunctionDistance &d) const {
1491     return !infinite &&
1492            (d.infinite || std::lexicographical_compare(
1493                               conversions.begin(), conversions.end(),
1494                               d.conversions.begin(), d.conversions.end()));
1495   }
1496
1497   bool isLosingPrecision() const {
1498     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1499   }
1500
1501   bool isInfinite() const { return infinite; }
1502
1503 private:
1504   enum class Conversion { Forbidden, None, Narrow, Extend };
1505
1506   void addArgumentDistance(mlir::Type from, mlir::Type to) {
1507     switch (conversionBetweenTypes(from, to)) {
1508     case Conversion::Forbidden:
1509       infinite = true;
1510       break;
1511     case Conversion::None:
1512       break;
1513     case Conversion::Narrow:
1514       conversions[narrowingArg]++;
1515       break;
1516     case Conversion::Extend:
1517       conversions[nonNarrowingArg]++;
1518       break;
1519     }
1520   }
1521
1522   void addResultDistance(mlir::Type from, mlir::Type to) {
1523     switch (conversionBetweenTypes(from, to)) {
1524     case Conversion::Forbidden:
1525       infinite = true;
1526       break;
1527     case Conversion::None:
1528       break;
1529     case Conversion::Narrow:
1530       conversions[nonExtendingResult]++;
1531       break;
1532     case Conversion::Extend:
1533       conversions[extendingResult]++;
1534       break;
1535     }
1536   }
1537
1538   // Floating point can be mlir::FloatType or fir::real
1539   static unsigned getFloatingPointWidth(mlir::Type t) {
1540     if (auto f{t.dyn_cast<mlir::FloatType>()})
1541       return f.getWidth();
1542     // FIXME: Get width another way for fir.real/complex
1543     // - use fir/KindMapping.h and llvm::Type
1544     // - or use evaluate/type.h
1545     if (auto r{t.dyn_cast<fir::RealType>()})
1546       return r.getFKind() * 4;
1547     if (auto cplx{t.dyn_cast<fir::ComplexType>()})
1548       return cplx.getFKind() * 4;
1549     llvm_unreachable("not a floating-point type");
1550   }
1551
1552   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1553     if (from == to)
1554       return Conversion::None;
1555
1556     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
1557       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
1558         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1559                                                          : Conversion::Extend;
1560       }
1561     }
1562
1563     if (fir::isa_real(from) && fir::isa_real(to)) {
1564       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
1565                  ? Conversion::Narrow
1566                  : Conversion::Extend;
1567     }
1568
1569     if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
1570       if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
1571         return getFloatingPointWidth(fromCplxTy) >
1572                        getFloatingPointWidth(toCplxTy)
1573                    ? Conversion::Narrow
1574                    : Conversion::Extend;
1575       }
1576     }
1577     // Notes:
1578     // - No conversion between character types, specialization of runtime
1579     // functions should be made instead.
1580     // - It is not clear there is a use case for automatic conversions
1581     // around Logical and it may damage hidden information in the physical
1582     // storage so do not do it.
1583     return Conversion::Forbidden;
1584   }
1585
1586   // Below are indexes to access data in conversions.
1587   // The order in data does matter for lexicographical_compare
1588   enum {
1589     narrowingArg = 0,   // usually bad
1590     extendingResult,    // usually bad
1591     nonExtendingResult, // usually ok
1592     nonNarrowingArg,    // usually ok
1593     dataSize
1594   };
1595
1596   std::array<int, dataSize> conversions = {};
1597   bool infinite = false; // When forbidden conversion or wrong argument number
1598 };
1599
1600 /// Build mlir::func::FuncOp from runtime symbol description and add
1601 /// fir.runtime attribute.
1602 static mlir::func::FuncOp getFuncOp(mlir::Location loc,
1603                                     fir::FirOpBuilder &builder,
1604                                     const RuntimeFunction &runtime) {
1605   mlir::func::FuncOp function = builder.addNamedFunction(
1606       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
1607   function->setAttr("fir.runtime", builder.getUnitAttr());
1608   return function;
1609 }
1610
1611 /// Select runtime function that has the smallest distance to the intrinsic
1612 /// function type and that will not imply narrowing arguments or extending the
1613 /// result.
1614 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1615 static mlir::func::FuncOp searchFunctionInLibrary(
1616     mlir::Location loc, fir::FirOpBuilder &builder,
1617     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
1618     llvm::StringRef name, mlir::FunctionType funcType,
1619     const RuntimeFunction **bestNearMatch,
1620     FunctionDistance &bestMatchDistance) {
1621   std::pair<const RuntimeFunction *, const RuntimeFunction *> range =
1622       lib.equal_range(name);
1623   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1624     const RuntimeFunction &impl = *iter;
1625     mlir::FunctionType implType = impl.typeGenerator(builder.getContext());
1626     if (funcType == implType)
1627       return getFuncOp(loc, builder, impl); // exact match
1628
1629     FunctionDistance distance(funcType, implType);
1630     if (distance.isSmallerThan(bestMatchDistance)) {
1631       *bestNearMatch = &impl;
1632       bestMatchDistance = std::move(distance);
1633     }
1634   }
1635   return {};
1636 }
1637
1638 using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
1639 static constexpr RtMap mathOps(mathOperations);
1640 static_assert(mathOps.Verify() && "map must be sorted");
1641
1642 /// Look for a MathOperation entry specifying how to lower a mathematical
1643 /// operation defined by \p name with its result' and operands' types
1644 /// specified in the form of a FunctionType \p funcType.
1645 /// If exact match for the given types is found, then the function
1646 /// returns a pointer to the corresponding MathOperation.
1647 /// Otherwise, the function returns nullptr.
1648 /// If there is a MathOperation that can be used with additional
1649 /// type casts for the operands or/and result (non-exact match),
1650 /// then it is returned via \p bestNearMatch argument, and
1651 /// \p bestMatchDistance specifies the FunctionDistance between
1652 /// the requested operation and the non-exact match.
1653 static const MathOperation *
1654 searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
1655                     mlir::FunctionType funcType,
1656                     const MathOperation **bestNearMatch,
1657                     FunctionDistance &bestMatchDistance) {
1658   auto range = mathOps.equal_range(name);
1659   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1660     const auto &impl = *iter;
1661     auto implType = impl.typeGenerator(builder.getContext());
1662     if (funcType == implType)
1663       return &impl; // exact match
1664
1665     FunctionDistance distance(funcType, implType);
1666     if (distance.isSmallerThan(bestMatchDistance)) {
1667       *bestNearMatch = &impl;
1668       bestMatchDistance = std::move(distance);
1669     }
1670   }
1671   return nullptr;
1672 }
1673
1674 /// Implementation of the operation defined by \p name with type
1675 /// \p funcType is not precise, and the actual available implementation
1676 /// is \p distance away from the requested. If using the available
1677 /// implementation results in a precision loss, emit an error message
1678 /// with the given code location \p loc.
1679 static void checkPrecisionLoss(llvm::StringRef name,
1680                                mlir::FunctionType funcType,
1681                                const FunctionDistance &distance,
1682                                mlir::Location loc) {
1683   if (!distance.isLosingPrecision())
1684     return;
1685
1686   // Using this runtime version requires narrowing the arguments
1687   // or extending the result. It is not numerically safe. There
1688   // is currently no quad math library that was described in
1689   // lowering and could be used here. Emit an error and continue
1690   // generating the code with the narrowing cast so that the user
1691   // can get a complete list of the problematic intrinsic calls.
1692   std::string message("not yet implemented: no math runtime available for '");
1693   llvm::raw_string_ostream sstream(message);
1694   if (name == "pow") {
1695     assert(funcType.getNumInputs() == 2 && "power operator has two arguments");
1696     sstream << funcType.getInput(0) << " ** " << funcType.getInput(1);
1697   } else {
1698     sstream << name << "(";
1699     if (funcType.getNumInputs() > 0)
1700       sstream << funcType.getInput(0);
1701     for (mlir::Type argType : funcType.getInputs().drop_front())
1702       sstream << ", " << argType;
1703     sstream << ")";
1704   }
1705   sstream << "'";
1706   mlir::emitError(loc, message);
1707 }
1708
1709 /// Search runtime for the best runtime function given an intrinsic name
1710 /// and interface. The interface may not be a perfect match in which case
1711 /// the caller is responsible to insert argument and return value conversions.
1712 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1713 static mlir::func::FuncOp getRuntimeFunction(mlir::Location loc,
1714                                              fir::FirOpBuilder &builder,
1715                                              llvm::StringRef name,
1716                                              mlir::FunctionType funcType) {
1717   const RuntimeFunction *bestNearMatch = nullptr;
1718   FunctionDistance bestMatchDistance;
1719   mlir::func::FuncOp match;
1720   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
1721   static constexpr RtMap pgmathF(pgmathFast);
1722   static_assert(pgmathF.Verify() && "map must be sorted");
1723   static constexpr RtMap pgmathR(pgmathRelaxed);
1724   static_assert(pgmathR.Verify() && "map must be sorted");
1725   static constexpr RtMap pgmathP(pgmathPrecise);
1726   static_assert(pgmathP.Verify() && "map must be sorted");
1727
1728   if (mathRuntimeVersion == fastVersion)
1729     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
1730                                     &bestNearMatch, bestMatchDistance);
1731   else if (mathRuntimeVersion == relaxedVersion)
1732     match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType,
1733                                     &bestNearMatch, bestMatchDistance);
1734   else if (mathRuntimeVersion == preciseVersion)
1735     match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType,
1736                                     &bestNearMatch, bestMatchDistance);
1737   else
1738     llvm_unreachable("unsupported mathRuntimeVersion");
1739
1740   return match;
1741 }
1742
1743 /// Helpers to get function type from arguments and result type.
1744 static mlir::FunctionType getFunctionType(llvm::Optional<mlir::Type> resultType,
1745                                           llvm::ArrayRef<mlir::Value> arguments,
1746                                           fir::FirOpBuilder &builder) {
1747   llvm::SmallVector<mlir::Type> argTypes;
1748   for (mlir::Value arg : arguments)
1749     argTypes.push_back(arg.getType());
1750   llvm::SmallVector<mlir::Type> resTypes;
1751   if (resultType)
1752     resTypes.push_back(*resultType);
1753   return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,
1754                                  resTypes);
1755 }
1756
1757 /// fir::ExtendedValue to mlir::Value translation layer
1758
1759 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1760                                    mlir::Location loc) {
1761   assert(val && "optional unhandled here");
1762   mlir::Type type = val.getType();
1763   mlir::Value base = val;
1764   mlir::IndexType indexType = builder.getIndexType();
1765   llvm::SmallVector<mlir::Value> extents;
1766
1767   fir::factory::CharacterExprHelper charHelper{builder, loc};
1768   // FIXME: we may want to allow non character scalar here.
1769   if (charHelper.isCharacterScalar(type))
1770     return charHelper.toExtendedValue(val);
1771
1772   if (auto refType = type.dyn_cast<fir::ReferenceType>())
1773     type = refType.getEleTy();
1774
1775   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
1776     type = arrayType.getEleTy();
1777     for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1778       if (extent == fir::SequenceType::getUnknownExtent())
1779         break;
1780       extents.emplace_back(
1781           builder.createIntegerConstant(loc, indexType, extent));
1782     }
1783     // Last extent might be missing in case of assumed-size. If more extents
1784     // could not be deduced from type, that's an error (a fir.box should
1785     // have been used in the interface).
1786     if (extents.size() + 1 < arrayType.getShape().size())
1787       mlir::emitError(loc, "cannot retrieve array extents from type");
1788   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
1789     fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1790   }
1791
1792   if (!extents.empty())
1793     return fir::ArrayBoxValue{base, extents};
1794   return base;
1795 }
1796
1797 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1798                     mlir::Location loc) {
1799   if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1800     mlir::Value buffer = charBox->getBuffer();
1801     auto buffTy = buffer.getType();
1802     if (buffTy.isa<mlir::FunctionType>())
1803       fir::emitFatalError(
1804           loc, "A character's buffer type cannot be a function type.");
1805     if (buffTy.isa<fir::BoxCharType>())
1806       return buffer;
1807     return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1808         buffer, charBox->getLen());
1809   }
1810
1811   // FIXME: need to access other ExtendedValue variants and handle them
1812   // properly.
1813   return fir::getBase(val);
1814 }
1815
1816 //===----------------------------------------------------------------------===//
1817 // IntrinsicLibrary
1818 //===----------------------------------------------------------------------===//
1819
1820 static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
1821   return name.startswith("c_") || name.startswith("compiler_") ||
1822          name.startswith("ieee_");
1823 }
1824
1825 /// Return the generic name of an intrinsic module procedure specific name.
1826 /// Remove any "__builtin_" prefix, and any specific suffix of the form
1827 /// {_[ail]?[0-9]+}*, such as _1 or _a4.
1828 llvm::StringRef genericName(llvm::StringRef specificName) {
1829   const std::string builtin = "__builtin_";
1830   llvm::StringRef name = specificName.startswith(builtin)
1831                              ? specificName.drop_front(builtin.size())
1832                              : specificName;
1833   size_t size = name.size();
1834   if (isIntrinsicModuleProcedure(name))
1835     while (isdigit(name[size - 1]))
1836       while (name[--size] != '_')
1837         ;
1838   return name.drop_back(name.size() - size);
1839 }
1840
1841 /// Generate a TODO error message for an as yet unimplemented intrinsic.
1842 void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
1843   if (isIntrinsicModuleProcedure(name))
1844     TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
1845   else
1846     TODO(loc, "intrinsic: " + llvm::Twine(name));
1847 }
1848
1849 template <typename GeneratorType>
1850 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
1851     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
1852     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1853   llvm::SmallVector<mlir::Value> scalarArgs;
1854   for (const fir::ExtendedValue &arg : args)
1855     if (arg.getUnboxed() || arg.getCharBox())
1856       scalarArgs.emplace_back(fir::getBase(arg));
1857     else
1858       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1859   if (outline)
1860     return outlineInWrapper(generator, name, resultType, scalarArgs);
1861   return invokeGenerator(generator, resultType, scalarArgs);
1862 }
1863
1864 template <>
1865 fir::ExtendedValue
1866 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
1867     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
1868     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1869   for (const fir::ExtendedValue &arg : args)
1870     if (!arg.getUnboxed() && !arg.getCharBox())
1871       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1872   if (outline)
1873     return outlineInExtendedWrapper(generator, name, resultType, args);
1874   return std::invoke(generator, *this, resultType, args);
1875 }
1876
1877 template <>
1878 fir::ExtendedValue
1879 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
1880     SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
1881     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1882   for (const fir::ExtendedValue &arg : args)
1883     if (!arg.getUnboxed() && !arg.getCharBox())
1884       // fir::emitFatalError(loc, "nonscalar intrinsic argument");
1885       crashOnMissingIntrinsic(loc, name);
1886   if (outline)
1887     return outlineInExtendedWrapper(generator, name, resultType, args);
1888   std::invoke(generator, *this, args);
1889   return mlir::Value();
1890 }
1891
1892 static fir::ExtendedValue
1893 invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
1894               const IntrinsicHandler &handler,
1895               llvm::Optional<mlir::Type> resultType,
1896               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1897               IntrinsicLibrary &lib) {
1898   assert(resultType && "expect elemental intrinsic to be functions");
1899   return lib.genElementalCall(generator, handler.name, *resultType, args,
1900                               outline);
1901 }
1902
1903 static fir::ExtendedValue
1904 invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
1905               const IntrinsicHandler &handler,
1906               llvm::Optional<mlir::Type> resultType,
1907               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1908               IntrinsicLibrary &lib) {
1909   assert(resultType && "expect intrinsic function");
1910   if (handler.isElemental)
1911     return lib.genElementalCall(generator, handler.name, *resultType, args,
1912                                 outline);
1913   if (outline)
1914     return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
1915                                         args);
1916   return std::invoke(generator, lib, *resultType, args);
1917 }
1918
1919 static fir::ExtendedValue
1920 invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
1921               const IntrinsicHandler &handler,
1922               llvm::Optional<mlir::Type> resultType,
1923               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1924               IntrinsicLibrary &lib) {
1925   if (handler.isElemental)
1926     return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
1927                                 outline);
1928   if (outline)
1929     return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
1930                                         args);
1931   std::invoke(generator, lib, args);
1932   return mlir::Value{};
1933 }
1934
1935 fir::ExtendedValue
1936 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
1937                                    llvm::Optional<mlir::Type> resultType,
1938                                    llvm::ArrayRef<fir::ExtendedValue> args) {
1939   llvm::StringRef name = genericName(specificName);
1940   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
1941     bool outline = handler->outline || outlineAllIntrinsics;
1942     return std::visit(
1943         [&](auto &generator) -> fir::ExtendedValue {
1944           return invokeHandler(generator, *handler, resultType, args, outline,
1945                                *this);
1946         },
1947         handler->generator);
1948   }
1949
1950   if (!resultType)
1951     // Subroutine should have a handler, they are likely missing for now.
1952     crashOnMissingIntrinsic(loc, name);
1953
1954   // Try the runtime if no special handler was defined for the
1955   // intrinsic being called. Maths runtime only has numerical elemental.
1956   // No optional arguments are expected at this point, the code will
1957   // crash if it gets absent optional.
1958
1959   // FIXME: using toValue to get the type won't work with array arguments.
1960   llvm::SmallVector<mlir::Value> mlirArgs;
1961   for (const fir::ExtendedValue &extendedVal : args) {
1962     mlir::Value val = toValue(extendedVal, builder, loc);
1963     if (!val)
1964       // If an absent optional gets there, most likely its handler has just
1965       // not yet been defined.
1966       crashOnMissingIntrinsic(loc, name);
1967     mlirArgs.emplace_back(val);
1968   }
1969   mlir::FunctionType soughtFuncType =
1970       getFunctionType(*resultType, mlirArgs, builder);
1971
1972   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
1973       getRuntimeCallGenerator(name, soughtFuncType);
1974   return genElementalCall(runtimeCallGenerator, name, *resultType, args,
1975                           /*outline=*/outlineAllIntrinsics);
1976 }
1977
1978 mlir::Value
1979 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
1980                                   mlir::Type resultType,
1981                                   llvm::ArrayRef<mlir::Value> args) {
1982   return std::invoke(generator, *this, resultType, args);
1983 }
1984
1985 mlir::Value
1986 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
1987                                   mlir::Type resultType,
1988                                   llvm::ArrayRef<mlir::Value> args) {
1989   return generator(builder, loc, args);
1990 }
1991
1992 mlir::Value
1993 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
1994                                   mlir::Type resultType,
1995                                   llvm::ArrayRef<mlir::Value> args) {
1996   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1997   for (mlir::Value arg : args)
1998     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1999   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
2000   return toValue(extendedResult, builder, loc);
2001 }
2002
2003 mlir::Value
2004 IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
2005                                   llvm::ArrayRef<mlir::Value> args) {
2006   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
2007   for (mlir::Value arg : args)
2008     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
2009   std::invoke(generator, *this, extendedArgs);
2010   return {};
2011 }
2012
2013 template <typename GeneratorType>
2014 mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
2015                                                 llvm::StringRef name,
2016                                                 mlir::FunctionType funcType,
2017                                                 bool loadRefArguments) {
2018   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
2019   mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
2020   if (!function) {
2021     // First time this wrapper is needed, build it.
2022     function = builder.createFunction(loc, wrapperName, funcType);
2023     function->setAttr("fir.intrinsic", builder.getUnitAttr());
2024     auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
2025     auto linkage =
2026         mlir::LLVM::LinkageAttr::get(builder.getContext(), internalLinkage);
2027     function->setAttr("llvm.linkage", linkage);
2028     function.addEntryBlock();
2029
2030     // Create local context to emit code into the newly created function
2031     // This new function is not linked to a source file location, only
2032     // its calls will be.
2033     auto localBuilder =
2034         std::make_unique<fir::FirOpBuilder>(function, builder.getKindMap());
2035     localBuilder->setInsertionPointToStart(&function.front());
2036     // Location of code inside wrapper of the wrapper is independent from
2037     // the location of the intrinsic call.
2038     mlir::Location localLoc = localBuilder->getUnknownLoc();
2039     llvm::SmallVector<mlir::Value> localArguments;
2040     for (mlir::BlockArgument bArg : function.front().getArguments()) {
2041       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
2042       if (loadRefArguments && refType) {
2043         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
2044         localArguments.push_back(loaded);
2045       } else {
2046         localArguments.push_back(bArg);
2047       }
2048     }
2049
2050     IntrinsicLibrary localLib{*localBuilder, localLoc};
2051
2052     if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
2053       localLib.invokeGenerator(generator, localArguments);
2054       localBuilder->create<mlir::func::ReturnOp>(localLoc);
2055     } else {
2056       assert(funcType.getNumResults() == 1 &&
2057              "expect one result for intrinsic function wrapper type");
2058       mlir::Type resultType = funcType.getResult(0);
2059       auto result =
2060           localLib.invokeGenerator(generator, resultType, localArguments);
2061       localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
2062     }
2063   } else {
2064     // Wrapper was already built, ensure it has the sought type
2065     assert(function.getFunctionType() == funcType &&
2066            "conflict between intrinsic wrapper types");
2067   }
2068   return function;
2069 }
2070
2071 /// Helpers to detect absent optional (not yet supported in outlining).
2072 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
2073   for (const mlir::Value &arg : args)
2074     if (!arg)
2075       return true;
2076   return false;
2077 }
2078 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
2079   for (const fir::ExtendedValue &arg : args)
2080     if (!fir::getBase(arg))
2081       return true;
2082   return false;
2083 }
2084
2085 template <typename GeneratorType>
2086 mlir::Value
2087 IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
2088                                    llvm::StringRef name, mlir::Type resultType,
2089                                    llvm::ArrayRef<mlir::Value> args) {
2090   if (hasAbsentOptional(args)) {
2091     // TODO: absent optional in outlining is an issue: we cannot just ignore
2092     // them. Needs a better interface here. The issue is that we cannot easily
2093     // tell that a value is optional or not here if it is presents. And if it is
2094     // absent, we cannot tell what it type should be.
2095     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
2096                   " with absent optional argument");
2097   }
2098
2099   mlir::FunctionType funcType = getFunctionType(resultType, args, builder);
2100   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
2101   return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0);
2102 }
2103
2104 template <typename GeneratorType>
2105 fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
2106     GeneratorType generator, llvm::StringRef name,
2107     llvm::Optional<mlir::Type> resultType,
2108     llvm::ArrayRef<fir::ExtendedValue> args) {
2109   if (hasAbsentOptional(args))
2110     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
2111                   " with absent optional argument");
2112   llvm::SmallVector<mlir::Value> mlirArgs;
2113   for (const auto &extendedVal : args)
2114     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
2115   mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
2116   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
2117   auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
2118   if (resultType)
2119     return toExtendedValue(call.getResult(0), builder, loc);
2120   // Subroutine calls
2121   return mlir::Value{};
2122 }
2123
2124 IntrinsicLibrary::RuntimeCallGenerator
2125 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
2126                                           mlir::FunctionType soughtFuncType) {
2127   mlir::func::FuncOp funcOp;
2128   mlir::FunctionType actualFuncType;
2129   const MathOperation *mathOp = nullptr;
2130
2131   // Look for a dedicated math operation generator, which
2132   // normally produces a single MLIR operation implementing
2133   // the math operation.
2134   // If not found fall back to a runtime function lookup.
2135   const MathOperation *bestNearMatch = nullptr;
2136   FunctionDistance bestMatchDistance;
2137   mathOp = searchMathOperation(builder, name, soughtFuncType, &bestNearMatch,
2138                                bestMatchDistance);
2139   if (!mathOp && bestNearMatch) {
2140     // Use the best near match, optionally issuing an error,
2141     // if types conversions cause precision loss.
2142     bool useBestNearMatch = true;
2143     // TODO: temporary workaround to avoid using math::PowFOp
2144     //       for pow(fp, i64) case and fall back to pgmath runtime.
2145     //       When proper Math dialect operations are available
2146     //       and added into mathOperations table, this can be removed.
2147     //       This is WIP in D129812.
2148     if (name == "pow" && soughtFuncType.getInput(0).isa<mlir::FloatType>())
2149       if (auto exponentTy =
2150               soughtFuncType.getInput(1).dyn_cast<mlir::IntegerType>())
2151         useBestNearMatch = exponentTy.getWidth() != 64;
2152
2153     if (useBestNearMatch) {
2154       checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, loc);
2155       mathOp = bestNearMatch;
2156     }
2157   }
2158   if (mathOp)
2159     actualFuncType = mathOp->typeGenerator(builder.getContext());
2160
2161   if (!mathOp)
2162     if ((funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType)))
2163       actualFuncType = funcOp.getFunctionType();
2164
2165   if (!mathOp && !funcOp) {
2166     std::string nameAndType;
2167     llvm::raw_string_ostream sstream(nameAndType);
2168     sstream << name << "\nrequested type: " << soughtFuncType;
2169     crashOnMissingIntrinsic(loc, nameAndType);
2170   }
2171
2172   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
2173          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
2174          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
2175
2176   return [funcOp, actualFuncType, mathOp,
2177           soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
2178                           llvm::ArrayRef<mlir::Value> args) {
2179     llvm::SmallVector<mlir::Value> convertedArguments;
2180     for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
2181       convertedArguments.push_back(builder.createConvert(loc, fst, snd));
2182     mlir::Value result;
2183     // Use math operation generator, if available.
2184     if (mathOp)
2185       result = mathOp->funcGenerator(builder, loc, mathOp->runtimeFunc,
2186                                      actualFuncType, convertedArguments);
2187     else
2188       result = builder.create<fir::CallOp>(loc, funcOp, convertedArguments)
2189                    .getResult(0);
2190     mlir::Type soughtType = soughtFuncType.getResult(0);
2191     return builder.createConvert(loc, soughtType, result);
2192   };
2193 }
2194
2195 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
2196     llvm::StringRef name, mlir::FunctionType signature) {
2197   // Unrestricted intrinsics signature follows implicit rules: argument
2198   // are passed by references. But the runtime versions expect values.
2199   // So instead of duplicating the runtime, just have the wrappers loading
2200   // this before calling the code generators.
2201   bool loadRefArguments = true;
2202   mlir::func::FuncOp funcOp;
2203   if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
2204     funcOp = std::visit(
2205         [&](auto generator) {
2206           return getWrapper(generator, name, signature, loadRefArguments);
2207         },
2208         handler->generator);
2209
2210   if (!funcOp) {
2211     llvm::SmallVector<mlir::Type> argTypes;
2212     for (mlir::Type type : signature.getInputs()) {
2213       if (auto refType = type.dyn_cast<fir::ReferenceType>())
2214         argTypes.push_back(refType.getEleTy());
2215       else
2216         argTypes.push_back(type);
2217     }
2218     mlir::FunctionType soughtFuncType =
2219         builder.getFunctionType(argTypes, signature.getResults());
2220     IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
2221         getRuntimeCallGenerator(name, soughtFuncType);
2222     funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
2223   }
2224
2225   return mlir::SymbolRefAttr::get(funcOp);
2226 }
2227
2228 void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
2229   assert(stmtCtx);
2230   fir::FirOpBuilder *bldr = &builder;
2231   stmtCtx->attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
2232 }
2233
2234 fir::ExtendedValue
2235 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
2236                                     mlir::Type resultType,
2237                                     llvm::StringRef intrinsicName) {
2238   fir::ExtendedValue res =
2239       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2240   return res.match(
2241       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2242         // Add cleanup code
2243         addCleanUpForTemp(loc, box.getAddr());
2244         return box;
2245       },
2246       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
2247         // Add cleanup code
2248         auto addr =
2249             builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
2250         addCleanUpForTemp(loc, addr);
2251         return box;
2252       },
2253       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
2254         // Add cleanup code
2255         addCleanUpForTemp(loc, box.getAddr());
2256         return box;
2257       },
2258       [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
2259         // Add cleanup code
2260         addCleanUpForTemp(loc, tempAddr);
2261         return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
2262       },
2263       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2264         // Add cleanup code
2265         addCleanUpForTemp(loc, box.getAddr());
2266         return box;
2267       },
2268       [&](const auto &) -> fir::ExtendedValue {
2269         fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
2270       });
2271 }
2272
2273 //===----------------------------------------------------------------------===//
2274 // Code generators for the intrinsic
2275 //===----------------------------------------------------------------------===//
2276
2277 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
2278                                              mlir::Type resultType,
2279                                              llvm::ArrayRef<mlir::Value> args) {
2280   mlir::FunctionType soughtFuncType =
2281       getFunctionType(resultType, args, builder);
2282   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
2283 }
2284
2285 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
2286                                             llvm::ArrayRef<mlir::Value> args) {
2287   // There can be an optional kind in second argument.
2288   assert(args.size() >= 1);
2289   return builder.convertWithSemantics(loc, resultType, args[0]);
2290 }
2291
2292 // ABORT
2293 void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
2294   assert(args.size() == 0);
2295   fir::runtime::genAbort(builder, loc);
2296 }
2297
2298 // ABS
2299 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
2300                                      llvm::ArrayRef<mlir::Value> args) {
2301   assert(args.size() == 1);
2302   mlir::Value arg = args[0];
2303   mlir::Type type = arg.getType();
2304   if (fir::isa_real(type) || fir::isa_complex(type)) {
2305     // Runtime call to fp abs. An alternative would be to use mlir
2306     // math::AbsFOp but it does not support all fir floating point types.
2307     return genRuntimeCall("abs", resultType, args);
2308   }
2309   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
2310     // At the time of this implementation there is no abs op in mlir.
2311     // So, implement abs here without branching.
2312     mlir::Value shift =
2313         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
2314     auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
2315     auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
2316     return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
2317   }
2318   llvm_unreachable("unexpected type in ABS argument");
2319 }
2320
2321 // ADJUSTL & ADJUSTR
2322 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
2323                               mlir::Value, mlir::Value)>
2324 fir::ExtendedValue
2325 IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
2326                                   llvm::ArrayRef<fir::ExtendedValue> args) {
2327   assert(args.size() == 1);
2328   mlir::Value string = builder.createBox(loc, args[0]);
2329   // Create a mutable fir.box to be passed to the runtime for the result.
2330   fir::MutableBoxValue resultMutableBox =
2331       fir::factory::createTempMutableBox(builder, loc, resultType);
2332   mlir::Value resultIrBox =
2333       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2334
2335   // Call the runtime -- the runtime will allocate the result.
2336   CallRuntime(builder, loc, resultIrBox, string);
2337
2338   // Read result from mutable fir.box and add it to the list of temps to be
2339   // finalized by the StatementContext.
2340   fir::ExtendedValue res =
2341       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2342   return res.match(
2343       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2344         addCleanUpForTemp(loc, fir::getBase(box));
2345         return box;
2346       },
2347       [&](const auto &) -> fir::ExtendedValue {
2348         fir::emitFatalError(loc, "result of ADJUSTL is not a scalar character");
2349       });
2350 }
2351
2352 // AIMAG
2353 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
2354                                        llvm::ArrayRef<mlir::Value> args) {
2355   assert(args.size() == 1);
2356   return fir::factory::Complex{builder, loc}.extractComplexPart(
2357       args[0], /*isImagPart=*/true);
2358 }
2359
2360 // AINT
2361 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
2362                                       llvm::ArrayRef<mlir::Value> args) {
2363   assert(args.size() >= 1 && args.size() <= 2);
2364   // Skip optional kind argument to search the runtime; it is already reflected
2365   // in result type.
2366   return genRuntimeCall("aint", resultType, {args[0]});
2367 }
2368
2369 // ALL
2370 fir::ExtendedValue
2371 IntrinsicLibrary::genAll(mlir::Type resultType,
2372                          llvm::ArrayRef<fir::ExtendedValue> args) {
2373
2374   assert(args.size() == 2);
2375   // Handle required mask argument
2376   mlir::Value mask = builder.createBox(loc, args[0]);
2377
2378   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2379   int rank = maskArry.rank();
2380   assert(rank >= 1);
2381
2382   // Handle optional dim argument
2383   bool absentDim = isStaticallyAbsent(args[1]);
2384   mlir::Value dim =
2385       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2386                 : fir::getBase(args[1]);
2387
2388   if (rank == 1 || absentDim)
2389     return builder.createConvert(loc, resultType,
2390                                  fir::runtime::genAll(builder, loc, mask, dim));
2391
2392   // else use the result descriptor AllDim() intrinsic
2393
2394   // Create mutable fir.box to be passed to the runtime for the result.
2395
2396   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2397   fir::MutableBoxValue resultMutableBox =
2398       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2399   mlir::Value resultIrBox =
2400       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2401
2402   // Call runtime. The runtime is allocating the result.
2403   fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
2404   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2405       .match(
2406           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2407             addCleanUpForTemp(loc, box.getAddr());
2408             return box;
2409           },
2410           [&](const auto &) -> fir::ExtendedValue {
2411             fir::emitFatalError(loc, "Invalid result for ALL");
2412           });
2413 }
2414
2415 // ALLOCATED
2416 fir::ExtendedValue
2417 IntrinsicLibrary::genAllocated(mlir::Type resultType,
2418                                llvm::ArrayRef<fir::ExtendedValue> args) {
2419   assert(args.size() == 1);
2420   return args[0].match(
2421       [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
2422         return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
2423       },
2424       [&](const auto &) -> fir::ExtendedValue {
2425         fir::emitFatalError(loc,
2426                             "allocated arg not lowered to MutableBoxValue");
2427       });
2428 }
2429
2430 // ANINT
2431 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
2432                                        llvm::ArrayRef<mlir::Value> args) {
2433   assert(args.size() >= 1 && args.size() <= 2);
2434   // Skip optional kind argument to search the runtime; it is already reflected
2435   // in result type.
2436   return genRuntimeCall("anint", resultType, {args[0]});
2437 }
2438
2439 // ANY
2440 fir::ExtendedValue
2441 IntrinsicLibrary::genAny(mlir::Type resultType,
2442                          llvm::ArrayRef<fir::ExtendedValue> args) {
2443
2444   assert(args.size() == 2);
2445   // Handle required mask argument
2446   mlir::Value mask = builder.createBox(loc, args[0]);
2447
2448   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2449   int rank = maskArry.rank();
2450   assert(rank >= 1);
2451
2452   // Handle optional dim argument
2453   bool absentDim = isStaticallyAbsent(args[1]);
2454   mlir::Value dim =
2455       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2456                 : fir::getBase(args[1]);
2457
2458   if (rank == 1 || absentDim)
2459     return builder.createConvert(loc, resultType,
2460                                  fir::runtime::genAny(builder, loc, mask, dim));
2461
2462   // else use the result descriptor AnyDim() intrinsic
2463
2464   // Create mutable fir.box to be passed to the runtime for the result.
2465
2466   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2467   fir::MutableBoxValue resultMutableBox =
2468       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2469   mlir::Value resultIrBox =
2470       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2471
2472   // Call runtime. The runtime is allocating the result.
2473   fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
2474   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2475       .match(
2476           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2477             addCleanUpForTemp(loc, box.getAddr());
2478             return box;
2479           },
2480           [&](const auto &) -> fir::ExtendedValue {
2481             fir::emitFatalError(loc, "Invalid result for ANY");
2482           });
2483 }
2484
2485 // ASSOCIATED
2486 fir::ExtendedValue
2487 IntrinsicLibrary::genAssociated(mlir::Type resultType,
2488                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2489   assert(args.size() == 2);
2490   auto *pointer =
2491       args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
2492                     [&](const auto &) -> const fir::MutableBoxValue * {
2493                       fir::emitFatalError(loc, "pointer not a MutableBoxValue");
2494                     });
2495   const fir::ExtendedValue &target = args[1];
2496   if (isStaticallyAbsent(target))
2497     return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
2498
2499   mlir::Value targetBox;
2500   if (fir::valueHasFirAttribute(fir::getBase(target),
2501                                 fir::getOptionalAttrName())) {
2502     // Subtle: contrary to other intrinsic optional arguments, disassociated
2503     // POINTER and unallocated ALLOCATABLE actual argument are not considered
2504     // absent here. This is because ASSOCIATED has special requirements for
2505     // TARGET actual arguments that are POINTERs. There is no precise
2506     // requirements for ALLOCATABLEs, but all existing Fortran compilers treat
2507     // them similarly to POINTERs. That is: unallocated TARGETs cause ASSOCIATED
2508     // to rerun false.  The runtime deals with the disassociated/unallocated
2509     // case. Simply ensures that TARGET that are OPTIONAL get conditionally
2510     // emboxed here to convey the optional aspect to the runtime.
2511     mlir::Type boxType = fir::BoxType::get(builder.getNoneType());
2512     auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
2513                                                       fir::getBase(target));
2514     targetBox = builder
2515                     .genIfOp(loc, {boxType}, isPresent,
2516                              /*withElseRegion=*/true)
2517                     .genThen([&]() {
2518                       mlir::Value box = builder.createBox(loc, target);
2519                       mlir::Value cast =
2520                           builder.createConvert(loc, boxType, box);
2521                       builder.create<fir::ResultOp>(loc, cast);
2522                     })
2523                     .genElse([&]() {
2524                       mlir::Value absentBox =
2525                           builder.create<fir::AbsentOp>(loc, boxType);
2526                       builder.create<fir::ResultOp>(loc, absentBox);
2527                     })
2528                     .getResults()[0];
2529   } else {
2530     targetBox = builder.createBox(loc, target);
2531   }
2532   mlir::Value pointerBoxRef =
2533       fir::factory::getMutableIRBox(builder, loc, *pointer);
2534   auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
2535   return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
2536 }
2537
2538 // BGE, BGT, BLE, BLT
2539 template <mlir::arith::CmpIPredicate pred>
2540 mlir::Value
2541 IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
2542                                     llvm::ArrayRef<mlir::Value> args) {
2543   assert(args.size() == 2);
2544
2545   mlir::Value arg0 = args[0];
2546   mlir::Value arg1 = args[1];
2547   mlir::Type arg0Ty = arg0.getType();
2548   mlir::Type arg1Ty = arg1.getType();
2549   unsigned bits0 = arg0Ty.getIntOrFloatBitWidth();
2550   unsigned bits1 = arg1Ty.getIntOrFloatBitWidth();
2551
2552   // Arguments do not have to be of the same integer type. However, if neither
2553   // of the arguments is a BOZ literal, then the shorter of the two needs
2554   // to be converted to the longer by zero-extending (not sign-extending)
2555   // to the left [Fortran 2008, 13.3.2].
2556   //
2557   // In the case of BOZ literals, the standard describes zero-extension or
2558   // truncation depending on the kind of the result [Fortran 2008, 13.3.3].
2559   // However, that seems to be relevant for the case where the type of the
2560   // result must match the type of the BOZ literal. That is not the case for
2561   // these intrinsics, so, again, zero-extend to the larger type.
2562   //
2563   if (bits0 > bits1)
2564     arg1 = builder.create<mlir::arith::ExtUIOp>(loc, arg0Ty, arg1);
2565   else if (bits0 < bits1)
2566     arg0 = builder.create<mlir::arith::ExtUIOp>(loc, arg1Ty, arg0);
2567
2568   return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
2569 }
2570
2571 // BTEST
2572 mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
2573                                        llvm::ArrayRef<mlir::Value> args) {
2574   // A conformant BTEST(I,POS) call satisfies:
2575   //     POS >= 0
2576   //     POS < BIT_SIZE(I)
2577   // Return:  (I >> POS) & 1
2578   assert(args.size() == 2);
2579   mlir::Type argType = args[0].getType();
2580   mlir::Value pos = builder.createConvert(loc, argType, args[1]);
2581   auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
2582   mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
2583   auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
2584   return builder.createConvert(loc, resultType, res);
2585 }
2586
2587 static fir::ExtendedValue
2588 genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
2589                  mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
2590                  bool isFunc = false) {
2591   assert(args.size() == 1);
2592   mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
2593   mlir::Value resAddr =
2594       fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType);
2595   mlir::Value argAddr;
2596   if (isFunc) {
2597     mlir::Value argValue = fir::getBase(args[0]);
2598     assert(argValue.getType().isa<fir::BoxProcType>() &&
2599            "c_funloc argument must have been lowered to a fir.boxproc");
2600     auto funcTy = argValue.getType().cast<fir::BoxProcType>().getEleTy();
2601     argAddr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
2602   } else {
2603     const auto *box = args[0].getBoxOf<fir::BoxValue>();
2604     assert(box && "c_loc argument must have been lowered to a fir.box");
2605     argAddr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
2606                                              fir::getBase(*box));
2607   }
2608   mlir::Value argAddrVal = builder.createConvert(
2609       loc, fir::unwrapRefType(resAddr.getType()), argAddr);
2610   builder.create<fir::StoreOp>(loc, argAddrVal, resAddr);
2611   return res;
2612 }
2613
2614 // C_F_POINTER
2615 void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
2616   assert(args.size() == 3);
2617   // Handle CPTR argument
2618   // Get the value of the C address or the result of a reference to C_LOC.
2619   mlir::Value cPtr = fir::getBase(args[0]);
2620   mlir::Type cPtrTy = fir::unwrapRefType(cPtr.getType());
2621   mlir::Value cPtrAddr =
2622       fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);
2623   mlir::Value cPtrAddrVal = builder.create<fir::LoadOp>(loc, cPtrAddr);
2624
2625   // Handle FPTR argument
2626   const auto *fPtr = args[1].getBoxOf<fir::MutableBoxValue>();
2627   assert(fPtr && "FPTR must be a pointer");
2628
2629   auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue {
2630     mlir::Value addr =
2631         builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
2632     mlir::SmallVector<mlir::Value> extents;
2633     if (box.hasRank()) {
2634       assert(isStaticallyPresent(args[2]) &&
2635              "FPTR argument must be an array if SHAPE argument exists");
2636       mlir::Value shape = fir::getBase(args[2]);
2637       int arrayRank = box.rank();
2638       mlir::Type shapeElementType =
2639           fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType()));
2640       mlir::Type idxType = builder.getIndexType();
2641       for (int i = 0; i < arrayRank; ++i) {
2642         mlir::Value index = builder.createIntegerConstant(loc, idxType, i);
2643         mlir::Value var = builder.create<fir::CoordinateOp>(
2644             loc, builder.getRefType(shapeElementType), shape, index);
2645         mlir::Value load = builder.create<fir::LoadOp>(loc, var);
2646         extents.push_back(builder.createConvert(loc, idxType, load));
2647       }
2648     }
2649     if (box.isCharacter()) {
2650       mlir::Value len = box.nonDeferredLenParams()[0];
2651       if (box.hasRank())
2652         return fir::CharArrayBoxValue{addr, len, extents};
2653       return fir::CharBoxValue{addr, len};
2654     }
2655     if (box.isDerivedWithLenParameters())
2656       TODO(loc, "get length parameters of derived type");
2657     if (box.hasRank())
2658       return fir::ArrayBoxValue{addr, extents};
2659     return addr;
2660   };
2661
2662   fir::factory::associateMutableBox(builder, loc, *fPtr, getCPtrExtVal(*fPtr),
2663                                     /*lbounds=*/mlir::ValueRange{});
2664 }
2665
2666 // C_FUNLOC
2667 fir::ExtendedValue
2668 IntrinsicLibrary::genCFunLoc(mlir::Type resultType,
2669                              llvm::ArrayRef<fir::ExtendedValue> args) {
2670   return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true);
2671 }
2672
2673 // C_LOC
2674 fir::ExtendedValue
2675 IntrinsicLibrary::genCLoc(mlir::Type resultType,
2676                           llvm::ArrayRef<fir::ExtendedValue> args) {
2677   return genCLocOrCFunLoc(builder, loc, resultType, args);
2678 }
2679
2680 // CEILING
2681 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
2682                                          llvm::ArrayRef<mlir::Value> args) {
2683   // Optional KIND argument.
2684   assert(args.size() >= 1);
2685   mlir::Value arg = args[0];
2686   // Use ceil that is not an actual Fortran intrinsic but that is
2687   // an llvm intrinsic that does the same, but return a floating
2688   // point.
2689   mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
2690   return builder.createConvert(loc, resultType, ceil);
2691 }
2692
2693 // CHAR
2694 fir::ExtendedValue
2695 IntrinsicLibrary::genChar(mlir::Type type,
2696                           llvm::ArrayRef<fir::ExtendedValue> args) {
2697   // Optional KIND argument.
2698   assert(args.size() >= 1);
2699   const mlir::Value *arg = args[0].getUnboxed();
2700   // expect argument to be a scalar integer
2701   if (!arg)
2702     mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
2703   fir::factory::CharacterExprHelper helper{builder, loc};
2704   fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
2705   mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
2706   mlir::Value len =
2707       builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
2708   return fir::CharBoxValue{cast, len};
2709 }
2710
2711 // CMPLX
2712 mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
2713                                        llvm::ArrayRef<mlir::Value> args) {
2714   assert(args.size() >= 1);
2715   fir::factory::Complex complexHelper(builder, loc);
2716   mlir::Type partType = complexHelper.getComplexPartType(resultType);
2717   mlir::Value real = builder.createConvert(loc, partType, args[0]);
2718   mlir::Value imag = isStaticallyAbsent(args, 1)
2719                          ? builder.createRealZeroConstant(loc, partType)
2720                          : builder.createConvert(loc, partType, args[1]);
2721   return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
2722                                                            imag);
2723 }
2724
2725 // COMMAND_ARGUMENT_COUNT
2726 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
2727     mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2728   assert(args.size() == 0);
2729   assert(resultType == builder.getDefaultIntegerType() &&
2730          "result type is not default integer kind type");
2731   return builder.createConvert(
2732       loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
2733   ;
2734 }
2735
2736 // CONJG
2737 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
2738                                        llvm::ArrayRef<mlir::Value> args) {
2739   assert(args.size() == 1);
2740   if (resultType != args[0].getType())
2741     llvm_unreachable("argument type mismatch");
2742
2743   mlir::Value cplx = args[0];
2744   auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
2745       cplx, /*isImagPart=*/true);
2746   auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
2747   return fir::factory::Complex{builder, loc}.insertComplexPart(
2748       cplx, negImag, /*isImagPart=*/true);
2749 }
2750
2751 // COUNT
2752 fir::ExtendedValue
2753 IntrinsicLibrary::genCount(mlir::Type resultType,
2754                            llvm::ArrayRef<fir::ExtendedValue> args) {
2755   assert(args.size() == 3);
2756
2757   // Handle mask argument
2758   fir::BoxValue mask = builder.createBox(loc, args[0]);
2759   unsigned maskRank = mask.rank();
2760
2761   assert(maskRank > 0);
2762
2763   // Handle optional dim argument
2764   bool absentDim = isStaticallyAbsent(args[1]);
2765   mlir::Value dim =
2766       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
2767                 : fir::getBase(args[1]);
2768
2769   if (absentDim || maskRank == 1) {
2770     // Result is scalar if no dim argument or mask is rank 1.
2771     // So, call specialized Count runtime routine.
2772     return builder.createConvert(
2773         loc, resultType,
2774         fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
2775   }
2776
2777   // Call general CountDim runtime routine.
2778
2779   // Handle optional kind argument
2780   bool absentKind = isStaticallyAbsent(args[2]);
2781   mlir::Value kind = absentKind ? builder.createIntegerConstant(
2782                                       loc, builder.getIndexType(),
2783                                       builder.getKindMap().defaultIntegerKind())
2784                                 : fir::getBase(args[2]);
2785
2786   // Create mutable fir.box to be passed to the runtime for the result.
2787   mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
2788   fir::MutableBoxValue resultMutableBox =
2789       fir::factory::createTempMutableBox(builder, loc, type);
2790
2791   mlir::Value resultIrBox =
2792       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2793
2794   fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
2795                             kind);
2796
2797   // Handle cleanup of allocatable result descriptor and return
2798   fir::ExtendedValue res =
2799       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2800   return res.match(
2801       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2802         // Add cleanup code
2803         addCleanUpForTemp(loc, box.getAddr());
2804         return box;
2805       },
2806       [&](const auto &) -> fir::ExtendedValue {
2807         fir::emitFatalError(loc, "unexpected result for COUNT");
2808       });
2809 }
2810
2811 // CPU_TIME
2812 void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2813   assert(args.size() == 1);
2814   const mlir::Value *arg = args[0].getUnboxed();
2815   assert(arg && "nonscalar cpu_time argument");
2816   mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
2817   mlir::Value res2 =
2818       builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
2819   builder.create<fir::StoreOp>(loc, res2, *arg);
2820 }
2821
2822 // CSHIFT
2823 fir::ExtendedValue
2824 IntrinsicLibrary::genCshift(mlir::Type resultType,
2825                             llvm::ArrayRef<fir::ExtendedValue> args) {
2826   assert(args.size() == 3);
2827
2828   // Handle required ARRAY argument
2829   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2830   mlir::Value array = fir::getBase(arrayBox);
2831   unsigned arrayRank = arrayBox.rank();
2832
2833   // Create mutable fir.box to be passed to the runtime for the result.
2834   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2835   fir::MutableBoxValue resultMutableBox =
2836       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2837   mlir::Value resultIrBox =
2838       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2839
2840   if (arrayRank == 1) {
2841     // Vector case
2842     // Handle required SHIFT argument as a scalar
2843     const mlir::Value *shiftAddr = args[1].getUnboxed();
2844     assert(shiftAddr && "nonscalar CSHIFT argument");
2845     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2846
2847     fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
2848   } else {
2849     // Non-vector case
2850     // Handle required SHIFT argument as an array
2851     mlir::Value shift = builder.createBox(loc, args[1]);
2852
2853     // Handle optional DIM argument
2854     mlir::Value dim =
2855         isStaticallyAbsent(args[2])
2856             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2857             : fir::getBase(args[2]);
2858     fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
2859   }
2860   return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
2861 }
2862
2863 // DATE_AND_TIME
2864 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2865   assert(args.size() == 4 && "date_and_time has 4 args");
2866   llvm::SmallVector<llvm::Optional<fir::CharBoxValue>> charArgs(3);
2867   for (unsigned i = 0; i < 3; ++i)
2868     if (const fir::CharBoxValue *charBox = args[i].getCharBox())
2869       charArgs[i] = *charBox;
2870
2871   mlir::Value values = fir::getBase(args[3]);
2872   if (!values)
2873     values = builder.create<fir::AbsentOp>(
2874         loc, fir::BoxType::get(builder.getNoneType()));
2875
2876   Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
2877                                  charArgs[2], values);
2878 }
2879
2880 // DIM
2881 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
2882                                      llvm::ArrayRef<mlir::Value> args) {
2883   assert(args.size() == 2);
2884   if (resultType.isa<mlir::IntegerType>()) {
2885     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2886     auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
2887     auto cmp = builder.create<mlir::arith::CmpIOp>(
2888         loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
2889     return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2890   }
2891   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
2892   mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
2893   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
2894   auto cmp = builder.create<mlir::arith::CmpFOp>(
2895       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
2896   return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2897 }
2898
2899 // DOT_PRODUCT
2900 fir::ExtendedValue
2901 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
2902                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2903   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
2904                     stmtCtx, args);
2905 }
2906
2907 // DPROD
2908 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
2909                                        llvm::ArrayRef<mlir::Value> args) {
2910   assert(args.size() == 2);
2911   assert(fir::isa_real(resultType) &&
2912          "Result must be double precision in DPROD");
2913   mlir::Value a = builder.createConvert(loc, resultType, args[0]);
2914   mlir::Value b = builder.createConvert(loc, resultType, args[1]);
2915   return builder.create<mlir::arith::MulFOp>(loc, a, b);
2916 }
2917
2918 // DSHIFTL
2919 mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
2920                                          llvm::ArrayRef<mlir::Value> args) {
2921   assert(args.size() == 3);
2922
2923   mlir::Value i = args[0];
2924   mlir::Value j = args[1];
2925   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2926   mlir::Value bitSize = builder.createIntegerConstant(
2927       loc, resultType, resultType.getIntOrFloatBitWidth());
2928
2929   // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
2930   // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
2931   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2932
2933   mlir::Value lArgs[2]{i, shift};
2934   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2935
2936   mlir::Value rArgs[2]{j, diff};
2937   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2938
2939   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2940 }
2941
2942 // DSHIFTR
2943 mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
2944                                          llvm::ArrayRef<mlir::Value> args) {
2945   assert(args.size() == 3);
2946
2947   mlir::Value i = args[0];
2948   mlir::Value j = args[1];
2949   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2950   mlir::Value bitSize = builder.createIntegerConstant(
2951       loc, resultType, resultType.getIntOrFloatBitWidth());
2952
2953   // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
2954   // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
2955   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2956
2957   mlir::Value lArgs[2]{i, diff};
2958   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2959
2960   mlir::Value rArgs[2]{j, shift};
2961   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2962
2963   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2964 }
2965
2966 // EOSHIFT
2967 fir::ExtendedValue
2968 IntrinsicLibrary::genEoshift(mlir::Type resultType,
2969                              llvm::ArrayRef<fir::ExtendedValue> args) {
2970   assert(args.size() == 4);
2971
2972   // Handle required ARRAY argument
2973   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2974   mlir::Value array = fir::getBase(arrayBox);
2975   unsigned arrayRank = arrayBox.rank();
2976
2977   // Create mutable fir.box to be passed to the runtime for the result.
2978   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2979   fir::MutableBoxValue resultMutableBox =
2980       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2981   mlir::Value resultIrBox =
2982       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2983
2984   // Handle optional BOUNDARY argument
2985   mlir::Value boundary =
2986       isStaticallyAbsent(args[2])
2987           ? builder.create<fir::AbsentOp>(
2988                 loc, fir::BoxType::get(builder.getNoneType()))
2989           : builder.createBox(loc, args[2]);
2990
2991   if (arrayRank == 1) {
2992     // Vector case
2993     // Handle required SHIFT argument as a scalar
2994     const mlir::Value *shiftAddr = args[1].getUnboxed();
2995     assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
2996     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2997     fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
2998                                    boundary);
2999   } else {
3000     // Non-vector case
3001     // Handle required SHIFT argument as an array
3002     mlir::Value shift = builder.createBox(loc, args[1]);
3003
3004     // Handle optional DIM argument
3005     mlir::Value dim =
3006         isStaticallyAbsent(args[3])
3007             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3008             : fir::getBase(args[3]);
3009     fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
3010                              dim);
3011   }
3012   return readAndAddCleanUp(resultMutableBox, resultType,
3013                            "unexpected result for EOSHIFT");
3014 }
3015
3016 // EXIT
3017 void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
3018   assert(args.size() == 1);
3019
3020   mlir::Value status =
3021       isStaticallyAbsent(args[0])
3022           ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
3023                                           EXIT_SUCCESS)
3024           : fir::getBase(args[0]);
3025
3026   assert(status.getType() == builder.getDefaultIntegerType() &&
3027          "STATUS parameter must be an INTEGER of default kind");
3028
3029   fir::runtime::genExit(builder, loc, status);
3030 }
3031
3032 // EXPONENT
3033 mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
3034                                           llvm::ArrayRef<mlir::Value> args) {
3035   assert(args.size() == 1);
3036
3037   return builder.createConvert(
3038       loc, resultType,
3039       fir::runtime::genExponent(builder, loc, resultType,
3040                                 fir::getBase(args[0])));
3041 }
3042
3043 // FLOOR
3044 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
3045                                        llvm::ArrayRef<mlir::Value> args) {
3046   // Optional KIND argument.
3047   assert(args.size() >= 1);
3048   mlir::Value arg = args[0];
3049   // Use LLVM floor that returns real.
3050   mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
3051   return builder.createConvert(loc, resultType, floor);
3052 }
3053
3054 // FRACTION
3055 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
3056                                           llvm::ArrayRef<mlir::Value> args) {
3057   assert(args.size() == 1);
3058
3059   return builder.createConvert(
3060       loc, resultType,
3061       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
3062 }
3063
3064 // GET_COMMAND_ARGUMENT
3065 void IntrinsicLibrary::genGetCommandArgument(
3066     llvm::ArrayRef<fir::ExtendedValue> args) {
3067   assert(args.size() == 5);
3068   mlir::Value number = fir::getBase(args[0]);
3069   const fir::ExtendedValue &value = args[1];
3070   const fir::ExtendedValue &length = args[2];
3071   const fir::ExtendedValue &status = args[3];
3072   const fir::ExtendedValue &errmsg = args[4];
3073
3074   if (!number)
3075     fir::emitFatalError(loc, "expected NUMBER parameter");
3076
3077   // If none of the optional parameters are present, do nothing.
3078   if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
3079       !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
3080     return;
3081
3082   mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3083   mlir::Value valBox =
3084       isStaticallyPresent(value)
3085           ? fir::getBase(value)
3086           : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3087   mlir::Value lenBox =
3088       isStaticallyPresent(length)
3089           ? fir::getBase(length)
3090           : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3091   mlir::Value errBox =
3092       isStaticallyPresent(errmsg)
3093           ? fir::getBase(errmsg)
3094           : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3095   mlir::Value stat = fir::runtime::genGetCommandArgument(
3096       builder, loc, number, valBox, lenBox, errBox);
3097   if (isStaticallyPresent(status)) {
3098     mlir::Value statAddr = fir::getBase(status);
3099     mlir::Value statIsPresentAtRuntime =
3100         builder.genIsNotNullAddr(loc, statAddr);
3101     builder.genIfThen(loc, statIsPresentAtRuntime)
3102         .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3103         .end();
3104   }
3105 }
3106
3107 // GET_ENVIRONMENT_VARIABLE
3108 void IntrinsicLibrary::genGetEnvironmentVariable(
3109     llvm::ArrayRef<fir::ExtendedValue> args) {
3110   assert(args.size() == 6);
3111   mlir::Value name = fir::getBase(args[0]);
3112   const fir::ExtendedValue &value = args[1];
3113   const fir::ExtendedValue &length = args[2];
3114   const fir::ExtendedValue &status = args[3];
3115   const fir::ExtendedValue &trimName = args[4];
3116   const fir::ExtendedValue &errmsg = args[5];
3117
3118   // Handle optional TRIM_NAME argument
3119   mlir::Value trim;
3120   if (isStaticallyAbsent(trimName)) {
3121     trim = builder.createBool(loc, true);
3122   } else {
3123     mlir::Type i1Ty = builder.getI1Type();
3124     mlir::Value trimNameAddr = fir::getBase(trimName);
3125     mlir::Value trimNameIsPresentAtRuntime =
3126         builder.genIsNotNullAddr(loc, trimNameAddr);
3127     trim = builder
3128                .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,
3129                         /*withElseRegion=*/true)
3130                .genThen([&]() {
3131                  auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr);
3132                  mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);
3133                  builder.create<fir::ResultOp>(loc, cast);
3134                })
3135                .genElse([&]() {
3136                  mlir::Value trueVal = builder.createBool(loc, true);
3137                  builder.create<fir::ResultOp>(loc, trueVal);
3138                })
3139                .getResults()[0];
3140   }
3141
3142   if (isStaticallyPresent(value) || isStaticallyPresent(status) ||
3143       isStaticallyPresent(errmsg)) {
3144     mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3145     mlir::Value valBox =
3146         isStaticallyPresent(value)
3147             ? fir::getBase(value)
3148             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3149     mlir::Value errBox =
3150         isStaticallyPresent(errmsg)
3151             ? fir::getBase(errmsg)
3152             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3153     mlir::Value stat = fir::runtime::genEnvVariableValue(builder, loc, name,
3154                                                          valBox, trim, errBox);
3155     if (isStaticallyPresent(status)) {
3156       mlir::Value statAddr = fir::getBase(status);
3157       mlir::Value statIsPresentAtRuntime =
3158           builder.genIsNotNullAddr(loc, statAddr);
3159       builder.genIfThen(loc, statIsPresentAtRuntime)
3160           .genThen(
3161               [&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3162           .end();
3163     }
3164   }
3165
3166   if (isStaticallyPresent(length)) {
3167     mlir::Value lenAddr = fir::getBase(length);
3168     mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr);
3169     builder.genIfThen(loc, lenIsPresentAtRuntime)
3170         .genThen([&]() {
3171           mlir::Value len =
3172               fir::runtime::genEnvVariableLength(builder, loc, name, trim);
3173           builder.createStoreWithConvert(loc, len, lenAddr);
3174         })
3175         .end();
3176   }
3177 }
3178
3179 // IALL
3180 fir::ExtendedValue
3181 IntrinsicLibrary::genIall(mlir::Type resultType,
3182                           llvm::ArrayRef<fir::ExtendedValue> args) {
3183   return genReduction(fir::runtime::genIAll, fir::runtime::genIAllDim,
3184                       resultType, builder, loc, stmtCtx,
3185                       "unexpected result for IALL", args);
3186 }
3187
3188 // IAND
3189 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
3190                                       llvm::ArrayRef<mlir::Value> args) {
3191   assert(args.size() == 2);
3192   auto arg0 = builder.createConvert(loc, resultType, args[0]);
3193   auto arg1 = builder.createConvert(loc, resultType, args[1]);
3194   return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
3195 }
3196
3197 // IANY
3198 fir::ExtendedValue
3199 IntrinsicLibrary::genIany(mlir::Type resultType,
3200                           llvm::ArrayRef<fir::ExtendedValue> args) {
3201   return genReduction(fir::runtime::genIAny, fir::runtime::genIAnyDim,
3202                       resultType, builder, loc, stmtCtx,
3203                       "unexpected result for IANY", args);
3204 }
3205
3206 // IBCLR
3207 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
3208                                        llvm::ArrayRef<mlir::Value> args) {
3209   // A conformant IBCLR(I,POS) call satisfies:
3210   //     POS >= 0
3211   //     POS < BIT_SIZE(I)
3212   // Return:  I & (!(1 << POS))
3213   assert(args.size() == 2);
3214   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3215   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3216   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3217   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
3218   auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
3219   return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
3220 }
3221
3222 // IBITS
3223 mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
3224                                        llvm::ArrayRef<mlir::Value> args) {
3225   // A conformant IBITS(I,POS,LEN) call satisfies:
3226   //     POS >= 0
3227   //     LEN >= 0
3228   //     POS + LEN <= BIT_SIZE(I)
3229   // Return:  LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
3230   // For a conformant call, implementing (I >> POS) with a signed or an
3231   // unsigned shift produces the same result.  For a nonconformant call,
3232   // the two choices may produce different results.
3233   assert(args.size() == 3);
3234   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3235   mlir::Value len = builder.createConvert(loc, resultType, args[2]);
3236   mlir::Value bitSize = builder.createIntegerConstant(
3237       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3238   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
3239   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3240   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3241   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
3242   auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
3243   auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
3244   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
3245       loc, mlir::arith::CmpIPredicate::eq, len, zero);
3246   return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
3247 }
3248
3249 // IBSET
3250 mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
3251                                        llvm::ArrayRef<mlir::Value> args) {
3252   // A conformant IBSET(I,POS) call satisfies:
3253   //     POS >= 0
3254   //     POS < BIT_SIZE(I)
3255   // Return:  I | (1 << POS)
3256   assert(args.size() == 2);
3257   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3258   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3259   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
3260   return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
3261 }
3262
3263 // ICHAR
3264 fir::ExtendedValue
3265 IntrinsicLibrary::genIchar(mlir::Type resultType,
3266                            llvm::ArrayRef<fir::ExtendedValue> args) {
3267   // There can be an optional kind in second argument.
3268   assert(args.size() == 2);
3269   const fir::CharBoxValue *charBox = args[0].getCharBox();
3270   if (!charBox)
3271     llvm::report_fatal_error("expected character scalar");
3272
3273   fir::factory::CharacterExprHelper helper{builder, loc};
3274   mlir::Value buffer = charBox->getBuffer();
3275   mlir::Type bufferTy = buffer.getType();
3276   mlir::Value charVal;
3277   if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
3278     assert(charTy.singleton());
3279     charVal = buffer;
3280   } else {
3281     // Character is in memory, cast to fir.ref<char> and load.
3282     mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
3283     if (!ty)
3284       llvm::report_fatal_error("expected memory type");
3285     // The length of in the character type may be unknown. Casting
3286     // to a singleton ref is required before loading.
3287     fir::CharacterType eleType = helper.getCharacterType(ty);
3288     fir::CharacterType charType =
3289         fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
3290     mlir::Type toTy = builder.getRefType(charType);
3291     mlir::Value cast = builder.createConvert(loc, toTy, buffer);
3292     charVal = builder.create<fir::LoadOp>(loc, cast);
3293   }
3294   LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
3295   auto code = helper.extractCodeFromSingleton(charVal);
3296   if (code.getType() == resultType)
3297     return code;
3298   return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
3299 }
3300
3301 // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
3302 // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
3303 template <mlir::arith::CmpIPredicate pred>
3304 fir::ExtendedValue
3305 IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
3306                                      llvm::ArrayRef<fir::ExtendedValue> args) {
3307   assert(args.size() == 2);
3308   mlir::Value arg0 = fir::getBase(args[0]);
3309   mlir::Value arg1 = fir::getBase(args[1]);
3310   auto recType =
3311       fir::unwrapPassByRefType(arg0.getType()).dyn_cast<fir::RecordType>();
3312   assert(recType.getTypeList().size() == 1 && "expected exactly one component");
3313   auto [fieldName, fieldType] = recType.getTypeList().front();
3314   mlir::Type fieldIndexType = fir::FieldType::get(recType.getContext());
3315   mlir::Value field = builder.create<fir::FieldIndexOp>(
3316       loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0));
3317   mlir::Value left = builder.create<fir::LoadOp>(
3318       loc, fieldType,
3319       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
3320                                         arg0, field));
3321   mlir::Value right = builder.create<fir::LoadOp>(
3322       loc, fieldType,
3323       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
3324                                         arg1, field));
3325   return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
3326 }
3327
3328 // IEEE_IS_FINITE
3329 mlir::Value
3330 IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
3331                                   llvm::ArrayRef<mlir::Value> args) {
3332   // IEEE_IS_FINITE(X) is true iff exponent(X) is the max exponent of kind(X).
3333   assert(args.size() == 1);
3334   mlir::Value floatVal = fir::getBase(args[0]);
3335   mlir::FloatType floatType = floatVal.getType().dyn_cast<mlir::FloatType>();
3336   int floatBits = floatType.getWidth();
3337   mlir::Type intType = builder.getIntegerType(
3338       floatType.isa<mlir::Float80Type>() ? 128 : floatBits);
3339   mlir::Value intVal =
3340       builder.create<mlir::arith::BitcastOp>(loc, intType, floatVal);
3341   int significandBits;
3342   if (floatType.isa<mlir::Float32Type>())
3343     significandBits = 23;
3344   else if (floatType.isa<mlir::Float64Type>())
3345     significandBits = 52;
3346   else // problems elsewhere for other kinds
3347     TODO(loc, "intrinsic module procedure: ieee_is_finite");
3348   mlir::Value significand =
3349       builder.createIntegerConstant(loc, intType, significandBits);
3350   int exponentBits = floatBits - 1 - significandBits;
3351   mlir::Value maxExponent =
3352       builder.createIntegerConstant(loc, intType, (1 << exponentBits) - 1);
3353   mlir::Value exponent = genIbits(
3354       intType, {intVal, significand,
3355                 builder.createIntegerConstant(loc, intType, exponentBits)});
3356   return builder.createConvert(
3357       loc, resultType,
3358       builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
3359                                           exponent, maxExponent));
3360 }
3361
3362 // IEOR
3363 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
3364                                       llvm::ArrayRef<mlir::Value> args) {
3365   assert(args.size() == 2);
3366   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3367 }
3368
3369 // INDEX
3370 fir::ExtendedValue
3371 IntrinsicLibrary::genIndex(mlir::Type resultType,
3372                            llvm::ArrayRef<fir::ExtendedValue> args) {
3373   assert(args.size() >= 2 && args.size() <= 4);
3374
3375   mlir::Value stringBase = fir::getBase(args[0]);
3376   fir::KindTy kind =
3377       fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3378           stringBase.getType());
3379   mlir::Value stringLen = fir::getLen(args[0]);
3380   mlir::Value substringBase = fir::getBase(args[1]);
3381   mlir::Value substringLen = fir::getLen(args[1]);
3382   mlir::Value back =
3383       isStaticallyAbsent(args, 2)
3384           ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3385           : fir::getBase(args[2]);
3386   if (isStaticallyAbsent(args, 3))
3387     return builder.createConvert(
3388         loc, resultType,
3389         fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
3390                                substringBase, substringLen, back));
3391
3392   // Call the descriptor-based Index implementation
3393   mlir::Value string = builder.createBox(loc, args[0]);
3394   mlir::Value substring = builder.createBox(loc, args[1]);
3395   auto makeRefThenEmbox = [&](mlir::Value b) {
3396     fir::LogicalType logTy = fir::LogicalType::get(
3397         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3398     mlir::Value temp = builder.createTemporary(loc, logTy);
3399     mlir::Value castb = builder.createConvert(loc, logTy, b);
3400     builder.create<fir::StoreOp>(loc, castb, temp);
3401     return builder.createBox(loc, temp);
3402   };
3403   mlir::Value backOpt = isStaticallyAbsent(args, 2)
3404                             ? builder.create<fir::AbsentOp>(
3405                                   loc, fir::BoxType::get(builder.getI1Type()))
3406                             : makeRefThenEmbox(fir::getBase(args[2]));
3407   mlir::Value kindVal = isStaticallyAbsent(args, 3)
3408                             ? builder.createIntegerConstant(
3409                                   loc, builder.getIndexType(),
3410                                   builder.getKindMap().defaultIntegerKind())
3411                             : fir::getBase(args[3]);
3412   // Create mutable fir.box to be passed to the runtime for the result.
3413   fir::MutableBoxValue mutBox =
3414       fir::factory::createTempMutableBox(builder, loc, resultType);
3415   mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
3416   // Call runtime. The runtime is allocating the result.
3417   fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
3418                                    backOpt, kindVal);
3419   // Read back the result from the mutable box.
3420   return readAndAddCleanUp(mutBox, resultType, "INDEX");
3421 }
3422
3423 // IOR
3424 mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
3425                                      llvm::ArrayRef<mlir::Value> args) {
3426   assert(args.size() == 2);
3427   return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
3428 }
3429
3430 // IPARITY
3431 fir::ExtendedValue
3432 IntrinsicLibrary::genIparity(mlir::Type resultType,
3433                              llvm::ArrayRef<fir::ExtendedValue> args) {
3434   return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim,
3435                       resultType, builder, loc, stmtCtx,
3436                       "unexpected result for IPARITY", args);
3437 }
3438
3439 // ISHFT
3440 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
3441                                        llvm::ArrayRef<mlir::Value> args) {
3442   // A conformant ISHFT(I,SHIFT) call satisfies:
3443   //     abs(SHIFT) <= BIT_SIZE(I)
3444   // Return:  abs(SHIFT) >= BIT_SIZE(I)
3445   //              ? 0
3446   //              : SHIFT < 0
3447   //                    ? I >> abs(SHIFT)
3448   //                    : I << abs(SHIFT)
3449   assert(args.size() == 2);
3450   mlir::Value bitSize = builder.createIntegerConstant(
3451       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3452   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3453   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3454   mlir::Value absShift = genAbs(resultType, {shift});
3455   auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
3456   auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
3457   auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
3458       loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
3459   auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
3460       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
3461   auto sel =
3462       builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
3463   return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
3464 }
3465
3466 // ISHFTC
3467 mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
3468                                         llvm::ArrayRef<mlir::Value> args) {
3469   // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
3470   //     SIZE > 0
3471   //     SIZE <= BIT_SIZE(I)
3472   //     abs(SHIFT) <= SIZE
3473   // if SHIFT > 0
3474   //     leftSize = abs(SHIFT)
3475   //     rightSize = SIZE - abs(SHIFT)
3476   // else [if SHIFT < 0]
3477   //     leftSize = SIZE - abs(SHIFT)
3478   //     rightSize = abs(SHIFT)
3479   // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
3480   // leftMaskShift = BIT_SIZE(I) - leftSize
3481   // rightMaskShift = BIT_SIZE(I) - rightSize
3482   // left = (I >> rightSize) & (-1 >> leftMaskShift)
3483   // right = (I & (-1 >> rightMaskShift)) << leftSize
3484   // Return:  SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
3485   assert(args.size() == 3);
3486   mlir::Value bitSize = builder.createIntegerConstant(
3487       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3488   mlir::Value I = args[0];
3489   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3490   mlir::Value size =
3491       args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
3492   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3493   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3494   mlir::Value absShift = genAbs(resultType, {shift});
3495   auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
3496   auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
3497       loc, mlir::arith::CmpIPredicate::eq, shift, zero);
3498   auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
3499       loc, mlir::arith::CmpIPredicate::eq, absShift, size);
3500   auto shiftIsNop =
3501       builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
3502   auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
3503       loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
3504   auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3505                                                         absShift, elseSize);
3506   auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3507                                                          elseSize, absShift);
3508   auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
3509       loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
3510   auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
3511   auto unchangedTmp2 =
3512       builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
3513   auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
3514                                                          unchangedTmp2, zero);
3515   auto leftMaskShift =
3516       builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
3517   auto leftMask =
3518       builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
3519   auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
3520   auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
3521   auto rightMaskShift =
3522       builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
3523   auto rightMask =
3524       builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
3525   auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
3526   auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
3527   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
3528   auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
3529   return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
3530 }
3531
3532 // LEADZ
3533 mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,
3534                                        llvm::ArrayRef<mlir::Value> args) {
3535   assert(args.size() == 1);
3536
3537   mlir::Value result =
3538       builder.create<mlir::math::CountLeadingZerosOp>(loc, args);
3539
3540   return builder.createConvert(loc, resultType, result);
3541 }
3542
3543 // LEN
3544 // Note that this is only used for an unrestricted intrinsic LEN call.
3545 // Other uses of LEN are rewritten as descriptor inquiries by the front-end.
3546 fir::ExtendedValue
3547 IntrinsicLibrary::genLen(mlir::Type resultType,
3548                          llvm::ArrayRef<fir::ExtendedValue> args) {
3549   // Optional KIND argument reflected in result type and otherwise ignored.
3550   assert(args.size() == 1 || args.size() == 2);
3551   mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
3552   return builder.createConvert(loc, resultType, len);
3553 }
3554
3555 // LEN_TRIM
3556 fir::ExtendedValue
3557 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
3558                              llvm::ArrayRef<fir::ExtendedValue> args) {
3559   // Optional KIND argument reflected in result type and otherwise ignored.
3560   assert(args.size() == 1 || args.size() == 2);
3561   const fir::CharBoxValue *charBox = args[0].getCharBox();
3562   if (!charBox)
3563     TODO(loc, "intrinsic: len_trim for character array");
3564   auto len =
3565       fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
3566   return builder.createConvert(loc, resultType, len);
3567 }
3568
3569 // LGE, LGT, LLE, LLT
3570 template <mlir::arith::CmpIPredicate pred>
3571 fir::ExtendedValue
3572 IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
3573                                       llvm::ArrayRef<fir::ExtendedValue> args) {
3574   assert(args.size() == 2);
3575   return fir::runtime::genCharCompare(
3576       builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
3577       fir::getBase(args[1]), fir::getLen(args[1]));
3578 }
3579
3580 // MASKL, MASKR
3581 template <typename Shift>
3582 mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
3583                                       llvm::ArrayRef<mlir::Value> args) {
3584   assert(args.size() == 2);
3585
3586   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3587   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3588   mlir::Value bitSize = builder.createIntegerConstant(
3589       loc, resultType, resultType.getIntOrFloatBitWidth());
3590   mlir::Value bitsToSet = builder.createConvert(loc, resultType, args[0]);
3591
3592   // The standard does not specify what to return if the number of bits to be
3593   // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
3594   // produce a poison value which may return a possibly platform-specific and/or
3595   // non-deterministic result. Other compilers don't produce a consistent result
3596   // in this case either, so we choose the most efficient implementation.
3597   mlir::Value shift =
3598       builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet);
3599   mlir::Value shifted = builder.create<Shift>(loc, ones, shift);
3600   mlir::Value isZero = builder.create<mlir::arith::CmpIOp>(
3601       loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero);
3602
3603   return builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted);
3604 }
3605
3606 // MATMUL
3607 fir::ExtendedValue
3608 IntrinsicLibrary::genMatmul(mlir::Type resultType,
3609                             llvm::ArrayRef<fir::ExtendedValue> args) {
3610   assert(args.size() == 2);
3611
3612   // Handle required matmul arguments
3613   fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
3614   mlir::Value matrixA = fir::getBase(matrixTmpA);
3615   fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
3616   mlir::Value matrixB = fir::getBase(matrixTmpB);
3617   unsigned resultRank =
3618       (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
3619
3620   // Create mutable fir.box to be passed to the runtime for the result.
3621   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
3622   fir::MutableBoxValue resultMutableBox =
3623       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3624   mlir::Value resultIrBox =
3625       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3626   // Call runtime. The runtime is allocating the result.
3627   fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
3628   // Read result from mutable fir.box and add it to the list of temps to be
3629   // finalized by the StatementContext.
3630   return readAndAddCleanUp(resultMutableBox, resultType,
3631                            "unexpected result for MATMUL");
3632 }
3633
3634 // MERGE
3635 fir::ExtendedValue
3636 IntrinsicLibrary::genMerge(mlir::Type,
3637                            llvm::ArrayRef<fir::ExtendedValue> args) {
3638   assert(args.size() == 3);
3639   mlir::Value tsource = fir::getBase(args[0]);
3640   mlir::Value fsource = fir::getBase(args[1]);
3641   mlir::Value rawMask = fir::getBase(args[2]);
3642   mlir::Type type0 = fir::unwrapRefType(tsource.getType());
3643   bool isCharRslt = fir::isa_char(type0); // result is same as first argument
3644   mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
3645   // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
3646   // types (one can have dynamic length while the other has constant lengths,
3647   // or one may be a fir.logical<> while the other is an i1). Insert a cast to
3648   // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
3649   mlir::Value fsourceCast =
3650       builder.createConvert(loc, tsource.getType(), fsource);
3651   auto rslt =
3652       builder.create<mlir::arith::SelectOp>(loc, mask, tsource, fsourceCast);
3653   if (isCharRslt) {
3654     // Need a CharBoxValue for character results
3655     const fir::CharBoxValue *charBox = args[0].getCharBox();
3656     fir::CharBoxValue charRslt(rslt, charBox->getLen());
3657     return charRslt;
3658   }
3659   return rslt;
3660 }
3661
3662 // MERGE_BITS
3663 mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
3664                                            llvm::ArrayRef<mlir::Value> args) {
3665   assert(args.size() == 3);
3666
3667   mlir::Value i = builder.createConvert(loc, resultType, args[0]);
3668   mlir::Value j = builder.createConvert(loc, resultType, args[1]);
3669   mlir::Value mask = builder.createConvert(loc, resultType, args[2]);
3670   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3671
3672   // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
3673   mlir::Value notMask = builder.create<mlir::arith::XOrIOp>(loc, mask, ones);
3674   mlir::Value lft = builder.create<mlir::arith::AndIOp>(loc, i, mask);
3675   mlir::Value rgt = builder.create<mlir::arith::AndIOp>(loc, j, notMask);
3676
3677   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3678 }
3679
3680 // MOD
3681 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
3682                                      llvm::ArrayRef<mlir::Value> args) {
3683   assert(args.size() == 2);
3684   if (resultType.isa<mlir::IntegerType>())
3685     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3686
3687   // Use runtime.
3688   return builder.createConvert(
3689       loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1]));
3690 }
3691
3692 // MODULO
3693 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
3694                                         llvm::ArrayRef<mlir::Value> args) {
3695   assert(args.size() == 2);
3696   // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
3697   // In the meantime, use a simple inlined implementation based on truncated
3698   // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
3699   // division and multiplication from MODULO formula.
3700   //  - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
3701   //  - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
3702   //    A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
3703   // Note that A/P < 0 if and only if A and P signs are different.
3704   if (resultType.isa<mlir::IntegerType>()) {
3705     auto remainder =
3706         builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3707     auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3708     mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
3709     auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
3710         loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
3711     auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
3712         loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
3713     auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3714                                                         argSignDifferent);
3715     auto remPlusP =
3716         builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
3717     return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3718                                                  remainder);
3719   }
3720   // Real case
3721   if (resultType == mlir::FloatType::getF128(builder.getContext()))
3722
3723     TODO(loc, "intrinsic: modulo for floating point of KIND=16");
3724   auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
3725   mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
3726   auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
3727       loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
3728   auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
3729       loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
3730   auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
3731       loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
3732   auto argSignDifferent =
3733       builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
3734   auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3735                                                       argSignDifferent);
3736   auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
3737   return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3738                                                remainder);
3739 }
3740
3741 // MVBITS
3742 void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
3743   // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
3744   //     FROMPOS >= 0
3745   //     LEN >= 0
3746   //     TOPOS >= 0
3747   //     FROMPOS + LEN <= BIT_SIZE(FROM)
3748   //     TOPOS + LEN <= BIT_SIZE(TO)
3749   // MASK = -1 >> (BIT_SIZE(FROM) - LEN)
3750   // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |
3751   //                      (((FROM >> FROMPOS) & MASK) << TOPOS)
3752   assert(args.size() == 5);
3753   auto unbox = [&](fir::ExtendedValue exv) {
3754     const mlir::Value *arg = exv.getUnboxed();
3755     assert(arg && "nonscalar mvbits argument");
3756     return *arg;
3757   };
3758   mlir::Value from = unbox(args[0]);
3759   mlir::Type resultType = from.getType();
3760   mlir::Value frompos = builder.createConvert(loc, resultType, unbox(args[1]));
3761   mlir::Value len = builder.createConvert(loc, resultType, unbox(args[2]));
3762   mlir::Value toAddr = unbox(args[3]);
3763   assert(fir::dyn_cast_ptrEleTy(toAddr.getType()) == resultType &&
3764          "mismatched mvbits types");
3765   auto to = builder.create<fir::LoadOp>(loc, resultType, toAddr);
3766   mlir::Value topos = builder.createConvert(loc, resultType, unbox(args[4]));
3767   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3768   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3769   mlir::Value bitSize = builder.createIntegerConstant(
3770       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3771   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
3772   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
3773   auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
3774   auto unchangedTmp2 =
3775       builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
3776   auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
3777   auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
3778   auto frombitsTmp2 =
3779       builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
3780   auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos);
3781   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
3782   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
3783       loc, mlir::arith::CmpIPredicate::eq, len, zero);
3784   auto res = builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
3785   builder.create<fir::StoreOp>(loc, res, toAddr);
3786 }
3787
3788 // NEAREST
3789 mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
3790                                          llvm::ArrayRef<mlir::Value> args) {
3791   assert(args.size() == 2);
3792
3793   mlir::Value realX = fir::getBase(args[0]);
3794   mlir::Value realS = fir::getBase(args[1]);
3795
3796   return builder.createConvert(
3797       loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS));
3798 }
3799
3800 // NINT
3801 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
3802                                       llvm::ArrayRef<mlir::Value> args) {
3803   assert(args.size() >= 1);
3804   // Skip optional kind argument to search the runtime; it is already reflected
3805   // in result type.
3806   return genRuntimeCall("nint", resultType, {args[0]});
3807 }
3808
3809 // NOT
3810 mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
3811                                      llvm::ArrayRef<mlir::Value> args) {
3812   assert(args.size() == 1);
3813   mlir::Value allOnes = builder.createIntegerConstant(loc, resultType, -1);
3814   return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
3815 }
3816
3817 // NULL
3818 fir::ExtendedValue
3819 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
3820   // NULL() without MOLD must be handled in the contexts where it can appear
3821   // (see table 16.5 of Fortran 2018 standard).
3822   assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
3823          "MOLD argument required to lower NULL outside of any context");
3824   const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
3825   assert(mold && "MOLD must be a pointer or allocatable");
3826   fir::BaseBoxType boxType = mold->getBoxTy();
3827   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
3828   mlir::Value box = fir::factory::createUnallocatedBox(
3829       builder, loc, boxType, mold->nonDeferredLenParams());
3830   builder.create<fir::StoreOp>(loc, box, boxStorage);
3831   return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
3832 }
3833
3834 // PACK
3835 fir::ExtendedValue
3836 IntrinsicLibrary::genPack(mlir::Type resultType,
3837                           llvm::ArrayRef<fir::ExtendedValue> args) {
3838   [[maybe_unused]] auto numArgs = args.size();
3839   assert(numArgs == 2 || numArgs == 3);
3840
3841   // Handle required array argument
3842   mlir::Value array = builder.createBox(loc, args[0]);
3843
3844   // Handle required mask argument
3845   mlir::Value mask = builder.createBox(loc, args[1]);
3846
3847   // Handle optional vector argument
3848   mlir::Value vector = isStaticallyAbsent(args, 2)
3849                            ? builder.create<fir::AbsentOp>(
3850                                  loc, fir::BoxType::get(builder.getI1Type()))
3851                            : builder.createBox(loc, args[2]);
3852
3853   // Create mutable fir.box to be passed to the runtime for the result.
3854   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
3855   fir::MutableBoxValue resultMutableBox =
3856       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3857   mlir::Value resultIrBox =
3858       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3859
3860   fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
3861
3862   return readAndAddCleanUp(resultMutableBox, resultType,
3863                            "unexpected result for PACK");
3864 }
3865
3866 // PARITY
3867 fir::ExtendedValue
3868 IntrinsicLibrary::genParity(mlir::Type resultType,
3869                             llvm::ArrayRef<fir::ExtendedValue> args) {
3870
3871   assert(args.size() == 2);
3872   // Handle required mask argument
3873   mlir::Value mask = builder.createBox(loc, args[0]);
3874
3875   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
3876   int rank = maskArry.rank();
3877   assert(rank >= 1);
3878
3879   // Handle optional dim argument
3880   bool absentDim = isStaticallyAbsent(args[1]);
3881   mlir::Value dim =
3882       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3883                 : fir::getBase(args[1]);
3884
3885   if (rank == 1 || absentDim)
3886     return builder.createConvert(
3887         loc, resultType, fir::runtime::genParity(builder, loc, mask, dim));
3888
3889   // else use the result descriptor ParityDim() intrinsic
3890
3891   // Create mutable fir.box to be passed to the runtime for the result.
3892
3893   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
3894   fir::MutableBoxValue resultMutableBox =
3895       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3896   mlir::Value resultIrBox =
3897       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3898
3899   // Call runtime. The runtime is allocating the result.
3900   fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim);
3901   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
3902       .match(
3903           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
3904             addCleanUpForTemp(loc, box.getAddr());
3905             return box;
3906           },
3907           [&](const auto &) -> fir::ExtendedValue {
3908             fir::emitFatalError(loc, "Invalid result for PARITY");
3909           });
3910 }
3911
3912 // POPCNT
3913 mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
3914                                         llvm::ArrayRef<mlir::Value> args) {
3915   assert(args.size() == 1);
3916
3917   mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
3918
3919   return builder.createConvert(loc, resultType, count);
3920 }
3921
3922 // POPPAR
3923 mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,
3924                                         llvm::ArrayRef<mlir::Value> args) {
3925   assert(args.size() == 1);
3926
3927   mlir::Value count = genPopcnt(resultType, args);
3928   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3929
3930   return builder.create<mlir::arith::AndIOp>(loc, count, one);
3931 }
3932
3933 // PRESENT
3934 fir::ExtendedValue
3935 IntrinsicLibrary::genPresent(mlir::Type,
3936                              llvm::ArrayRef<fir::ExtendedValue> args) {
3937   assert(args.size() == 1);
3938   return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
3939                                           fir::getBase(args[0]));
3940 }
3941
3942 // PRODUCT
3943 fir::ExtendedValue
3944 IntrinsicLibrary::genProduct(mlir::Type resultType,
3945                              llvm::ArrayRef<fir::ExtendedValue> args) {
3946   return genReduction(fir::runtime::genProduct, fir::runtime::genProductDim,
3947                       resultType, builder, loc, stmtCtx,
3948                       "unexpected result for Product", args);
3949 }
3950
3951 // RANDOM_INIT
3952 void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
3953   assert(args.size() == 2);
3954   Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]),
3955                                 fir::getBase(args[1]));
3956 }
3957
3958 // RANDOM_NUMBER
3959 void IntrinsicLibrary::genRandomNumber(
3960     llvm::ArrayRef<fir::ExtendedValue> args) {
3961   assert(args.size() == 1);
3962   Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
3963 }
3964
3965 // RANDOM_SEED
3966 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
3967   assert(args.size() == 3);
3968   mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3969   auto getDesc = [&](int i) {
3970     return isStaticallyPresent(args[i])
3971                ? fir::getBase(args[i])
3972                : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3973   };
3974   mlir::Value size = getDesc(0);
3975   mlir::Value put = getDesc(1);
3976   mlir::Value get = getDesc(2);
3977   Fortran::lower::genRandomSeed(builder, loc, size, put, get);
3978 }
3979
3980 // REDUCE
3981 fir::ExtendedValue
3982 IntrinsicLibrary::genReduce(mlir::Type resultType,
3983                             llvm::ArrayRef<fir::ExtendedValue> args) {
3984   TODO(loc, "intrinsic: reduce");
3985 }
3986
3987 // REPEAT
3988 fir::ExtendedValue
3989 IntrinsicLibrary::genRepeat(mlir::Type resultType,
3990                             llvm::ArrayRef<fir::ExtendedValue> args) {
3991   assert(args.size() == 2);
3992   mlir::Value string = builder.createBox(loc, args[0]);
3993   mlir::Value ncopies = fir::getBase(args[1]);
3994   // Create mutable fir.box to be passed to the runtime for the result.
3995   fir::MutableBoxValue resultMutableBox =
3996       fir::factory::createTempMutableBox(builder, loc, resultType);
3997   mlir::Value resultIrBox =
3998       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3999   // Call runtime. The runtime is allocating the result.
4000   fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
4001   // Read result from mutable fir.box and add it to the list of temps to be
4002   // finalized by the StatementContext.
4003   return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
4004 }
4005
4006 // RESHAPE
4007 fir::ExtendedValue
4008 IntrinsicLibrary::genReshape(mlir::Type resultType,
4009                              llvm::ArrayRef<fir::ExtendedValue> args) {
4010   assert(args.size() == 4);
4011
4012   // Handle source argument
4013   mlir::Value source = builder.createBox(loc, args[0]);
4014
4015   // Handle shape argument
4016   mlir::Value shape = builder.createBox(loc, args[1]);
4017   assert(fir::BoxValue(shape).rank() == 1);
4018   mlir::Type shapeTy = shape.getType();
4019   mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
4020   auto resultRank = shapeArrTy.cast<fir::SequenceType>().getShape()[0];
4021
4022   if (resultRank == fir::SequenceType::getUnknownExtent())
4023     TODO(loc, "intrinsic: reshape requires computing rank of result");
4024
4025   // Handle optional pad argument
4026   mlir::Value pad = isStaticallyAbsent(args[2])
4027                         ? builder.create<fir::AbsentOp>(
4028                               loc, fir::BoxType::get(builder.getI1Type()))
4029                         : builder.createBox(loc, args[2]);
4030
4031   // Handle optional order argument
4032   mlir::Value order = isStaticallyAbsent(args[3])
4033                           ? builder.create<fir::AbsentOp>(
4034                                 loc, fir::BoxType::get(builder.getI1Type()))
4035                           : builder.createBox(loc, args[3]);
4036
4037   // Create mutable fir.box to be passed to the runtime for the result.
4038   mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);
4039   fir::MutableBoxValue resultMutableBox =
4040       fir::factory::createTempMutableBox(builder, loc, type);
4041
4042   mlir::Value resultIrBox =
4043       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4044
4045   fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
4046                            order);
4047
4048   return readAndAddCleanUp(resultMutableBox, resultType,
4049                            "unexpected result for RESHAPE");
4050 }
4051
4052 // RRSPACING
4053 mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
4054                                            llvm::ArrayRef<mlir::Value> args) {
4055   assert(args.size() == 1);
4056
4057   return builder.createConvert(
4058       loc, resultType,
4059       fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
4060 }
4061
4062 // SCALE
4063 mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
4064                                        llvm::ArrayRef<mlir::Value> args) {
4065   assert(args.size() == 2);
4066
4067   mlir::Value realX = fir::getBase(args[0]);
4068   mlir::Value intI = fir::getBase(args[1]);
4069
4070   return builder.createConvert(
4071       loc, resultType, fir::runtime::genScale(builder, loc, realX, intI));
4072 }
4073
4074 // SCAN
4075 fir::ExtendedValue
4076 IntrinsicLibrary::genScan(mlir::Type resultType,
4077                           llvm::ArrayRef<fir::ExtendedValue> args) {
4078
4079   assert(args.size() == 4);
4080
4081   if (isStaticallyAbsent(args[3])) {
4082     // Kind not specified, so call scan/verify runtime routine that is
4083     // specialized on the kind of characters in string.
4084
4085     // Handle required string base arg
4086     mlir::Value stringBase = fir::getBase(args[0]);
4087
4088     // Handle required set string base arg
4089     mlir::Value setBase = fir::getBase(args[1]);
4090
4091     // Handle kind argument; it is the kind of character in this case
4092     fir::KindTy kind =
4093         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
4094             stringBase.getType());
4095
4096     // Get string length argument
4097     mlir::Value stringLen = fir::getLen(args[0]);
4098
4099     // Get set string length argument
4100     mlir::Value setLen = fir::getLen(args[1]);
4101
4102     // Handle optional back argument
4103     mlir::Value back =
4104         isStaticallyAbsent(args[2])
4105             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
4106             : fir::getBase(args[2]);
4107
4108     return builder.createConvert(loc, resultType,
4109                                  fir::runtime::genScan(builder, loc, kind,
4110                                                        stringBase, stringLen,
4111                                                        setBase, setLen, back));
4112   }
4113   // else use the runtime descriptor version of scan/verify
4114
4115   // Handle optional argument, back
4116   auto makeRefThenEmbox = [&](mlir::Value b) {
4117     fir::LogicalType logTy = fir::LogicalType::get(
4118         builder.getContext(), builder.getKindMap().defaultLogicalKind());
4119     mlir::Value temp = builder.createTemporary(loc, logTy);
4120     mlir::Value castb = builder.createConvert(loc, logTy, b);
4121     builder.create<fir::StoreOp>(loc, castb, temp);
4122     return builder.createBox(loc, temp);
4123   };
4124   mlir::Value back = fir::isUnboxedValue(args[2])
4125                          ? makeRefThenEmbox(*args[2].getUnboxed())
4126                          : builder.create<fir::AbsentOp>(
4127                                loc, fir::BoxType::get(builder.getI1Type()));
4128
4129   // Handle required string argument
4130   mlir::Value string = builder.createBox(loc, args[0]);
4131
4132   // Handle required set argument
4133   mlir::Value set = builder.createBox(loc, args[1]);
4134
4135   // Handle kind argument
4136   mlir::Value kind = fir::getBase(args[3]);
4137
4138   // Create result descriptor
4139   fir::MutableBoxValue resultMutableBox =
4140       fir::factory::createTempMutableBox(builder, loc, resultType);
4141   mlir::Value resultIrBox =
4142       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4143
4144   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
4145                                   kind);
4146
4147   // Handle cleanup of allocatable result descriptor and return
4148   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
4149 }
4150
4151 // SELECTED_INT_KIND
4152 mlir::Value
4153 IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType,
4154                                      llvm::ArrayRef<mlir::Value> args) {
4155   assert(args.size() == 1);
4156
4157   return builder.createConvert(
4158       loc, resultType,
4159       fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0])));
4160 }
4161
4162 // SELECTED_REAL_KIND
4163 mlir::Value
4164 IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
4165                                       llvm::ArrayRef<mlir::Value> args) {
4166   assert(args.size() == 3);
4167
4168   // Handle optional precision(P) argument
4169   mlir::Value precision =
4170       isStaticallyAbsent(args[0])
4171           ? builder.create<fir::AbsentOp>(
4172                 loc, fir::ReferenceType::get(builder.getI1Type()))
4173           : fir::getBase(args[0]);
4174
4175   // Handle optional range(R) argument
4176   mlir::Value range =
4177       isStaticallyAbsent(args[1])
4178           ? builder.create<fir::AbsentOp>(
4179                 loc, fir::ReferenceType::get(builder.getI1Type()))
4180           : fir::getBase(args[1]);
4181
4182   // Handle optional radix(RADIX) argument
4183   mlir::Value radix =
4184       isStaticallyAbsent(args[2])
4185           ? builder.create<fir::AbsentOp>(
4186                 loc, fir::ReferenceType::get(builder.getI1Type()))
4187           : fir::getBase(args[2]);
4188
4189   return builder.createConvert(
4190       loc, resultType,
4191       fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));
4192 }
4193
4194 // SET_EXPONENT
4195 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
4196                                              llvm::ArrayRef<mlir::Value> args) {
4197   assert(args.size() == 2);
4198
4199   return builder.createConvert(
4200       loc, resultType,
4201       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
4202                                    fir::getBase(args[1])));
4203 }
4204
4205 // SHIFTL, SHIFTR
4206 template <typename Shift>
4207 mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
4208                                        llvm::ArrayRef<mlir::Value> args) {
4209   assert(args.size() == 2);
4210
4211   // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by
4212   // the standard. However, several other compilers behave this way, so try and
4213   // maintain compatibility with them to an extent.
4214
4215   unsigned bits = resultType.getIntOrFloatBitWidth();
4216   mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
4217   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
4218   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
4219
4220   mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
4221       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
4222   mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>(
4223       loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
4224   mlir::Value outOfBounds =
4225       builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
4226
4227   mlir::Value shifted = builder.create<Shift>(loc, args[0], shift);
4228   return builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
4229 }
4230
4231 // SHIFTA
4232 mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
4233                                         llvm::ArrayRef<mlir::Value> args) {
4234   unsigned bits = resultType.getIntOrFloatBitWidth();
4235   mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
4236   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
4237   mlir::Value shiftEqBitSize = builder.create<mlir::arith::CmpIOp>(
4238       loc, mlir::arith::CmpIPredicate::eq, shift, bitSize);
4239
4240   // Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when
4241   // the shift amount is equal to the element size.
4242   // So if SHIFT is equal to the bit width then it is handled as a special case.
4243   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
4244   mlir::Value minusOne = builder.createIntegerConstant(loc, resultType, -1);
4245   mlir::Value valueIsNeg = builder.create<mlir::arith::CmpIOp>(
4246       loc, mlir::arith::CmpIPredicate::slt, args[0], zero);
4247   mlir::Value specialRes =
4248       builder.create<mlir::arith::SelectOp>(loc, valueIsNeg, minusOne, zero);
4249
4250   mlir::Value shifted =
4251       builder.create<mlir::arith::ShRSIOp>(loc, args[0], shift);
4252   return builder.create<mlir::arith::SelectOp>(loc, shiftEqBitSize, specialRes,
4253                                                shifted);
4254 }
4255
4256 // SIGN
4257 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
4258                                       llvm::ArrayRef<mlir::Value> args) {
4259   assert(args.size() == 2);
4260   if (resultType.isa<mlir::IntegerType>()) {
4261     mlir::Value abs = genAbs(resultType, {args[0]});
4262     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
4263     auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
4264     auto cmp = builder.create<mlir::arith::CmpIOp>(
4265         loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
4266     return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
4267   }
4268   return genRuntimeCall("sign", resultType, args);
4269 }
4270
4271 // SIZE
4272 fir::ExtendedValue
4273 IntrinsicLibrary::genSize(mlir::Type resultType,
4274                           llvm::ArrayRef<fir::ExtendedValue> args) {
4275   // Note that the value of the KIND argument is already reflected in the
4276   // resultType
4277   assert(args.size() == 3);
4278   if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
4279     if (boxValue->hasAssumedRank())
4280       TODO(loc, "intrinsic: size with assumed rank argument");
4281
4282   // Get the ARRAY argument
4283   mlir::Value array = builder.createBox(loc, args[0]);
4284
4285   // The front-end rewrites SIZE without the DIM argument to
4286   // an array of SIZE with DIM in most cases, but it may not be
4287   // possible in some cases like when in SIZE(function_call()).
4288   if (isStaticallyAbsent(args, 1))
4289     return builder.createConvert(loc, resultType,
4290                                  fir::runtime::genSize(builder, loc, array));
4291
4292   // Get the DIM argument.
4293   mlir::Value dim = fir::getBase(args[1]);
4294   if (!fir::isa_ref_type(dim.getType()))
4295     return builder.createConvert(
4296         loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
4297
4298   mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);
4299   return builder
4300       .genIfOp(loc, {resultType}, isDynamicallyAbsent,
4301                /*withElseRegion=*/true)
4302       .genThen([&]() {
4303         mlir::Value size = builder.createConvert(
4304             loc, resultType, fir::runtime::genSize(builder, loc, array));
4305         builder.create<fir::ResultOp>(loc, size);
4306       })
4307       .genElse([&]() {
4308         mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
4309         mlir::Value size = builder.createConvert(
4310             loc, resultType,
4311             fir::runtime::genSizeDim(builder, loc, array, dimValue));
4312         builder.create<fir::ResultOp>(loc, size);
4313       })
4314       .getResults()[0];
4315 }
4316
4317 // TRAILZ
4318 mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,
4319                                         llvm::ArrayRef<mlir::Value> args) {
4320   assert(args.size() == 1);
4321
4322   mlir::Value result =
4323       builder.create<mlir::math::CountTrailingZerosOp>(loc, args);
4324
4325   return builder.createConvert(loc, resultType, result);
4326 }
4327
4328 static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {
4329   return exv.match(
4330       [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },
4331       [](const fir::CharArrayBoxValue &arr) {
4332         return arr.getLBounds().empty();
4333       },
4334       [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },
4335       [](const auto &) { return false; });
4336 }
4337
4338 /// Compute the lower bound in dimension \p dim (zero based) of \p array
4339 /// taking care of returning one when the related extent is zero.
4340 static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
4341                                  const fir::ExtendedValue &array, unsigned dim,
4342                                  mlir::Value zero, mlir::Value one) {
4343   assert(dim < array.rank() && "invalid dimension");
4344   if (hasDefaultLowerBound(array))
4345     return one;
4346   mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
4347   if (dim + 1 == array.rank() && array.isAssumedSize())
4348     return lb;
4349   mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
4350   zero = builder.createConvert(loc, extent.getType(), zero);
4351   auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
4352       loc, mlir::arith::CmpIPredicate::eq, extent, zero);
4353   one = builder.createConvert(loc, lb.getType(), one);
4354   return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
4355 }
4356
4357 /// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
4358 /// This ensure that local lower bounds of assumed shape are propagated and that
4359 /// a fir.box with equivalent LBOUNDs but an explicit shape is created for
4360 /// assumed size arrays to avoid undefined behaviors in codegen or the runtime.
4361 static mlir::Value
4362 createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
4363                                 const fir::ExtendedValue &array) {
4364   if (!array.isAssumedSize())
4365     return array.match(
4366         [&](const fir::BoxValue &boxValue) -> mlir::Value {
4367           // This entity is mapped to a fir.box that may not contain the local
4368           // lower bound information if it is a dummy. Rebox it with the local
4369           // shape information.
4370           mlir::Value localShape = builder.createShape(loc, array);
4371           mlir::Value oldBox = boxValue.getAddr();
4372           return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
4373                                               localShape,
4374                                               /*slice=*/mlir::Value{});
4375         },
4376         [&](const auto &) -> mlir::Value {
4377           // This a pointer/allocatable, or an entity not yet tracked with a
4378           // fir.box. For pointer/allocatable, createBox will forward the
4379           // descriptor that contains the correct lower bound information. For
4380           // other entities, a new fir.box will be made with the local lower
4381           // bounds.
4382           return builder.createBox(loc, array);
4383         });
4384   // Assumed sized are not meant to be emboxed. This could cause the undefined
4385   // extent cannot safely be understood by the runtime/codegen that will
4386   // consider that the dimension is empty and that the related LBOUND value must
4387   // be one. Pretend that the related extent is one to get the correct LBOUND
4388   // value.
4389   llvm::SmallVector<mlir::Value> shape =
4390       fir::factory::getExtents(loc, builder, array);
4391   assert(!shape.empty() && "assumed size must have at least one dimension");
4392   shape.back() = builder.createIntegerConstant(loc, builder.getIndexType(), 1);
4393   auto safeToEmbox = array.match(
4394       [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue {
4395         return fir::CharArrayBoxValue{x.getAddr(), x.getLen(), shape,
4396                                       x.getLBounds()};
4397       },
4398       [&](const fir::ArrayBoxValue &x) -> fir::ExtendedValue {
4399         return fir::ArrayBoxValue{x.getAddr(), shape, x.getLBounds()};
4400       },
4401       [&](const auto &) -> fir::ExtendedValue {
4402         fir::emitFatalError(loc, "not an assumed size array");
4403       });
4404   return builder.createBox(loc, safeToEmbox);
4405 }
4406
4407 // LBOUND
4408 fir::ExtendedValue
4409 IntrinsicLibrary::genLbound(mlir::Type resultType,
4410                             llvm::ArrayRef<fir::ExtendedValue> args) {
4411   assert(args.size() == 2 || args.size() == 3);
4412   const fir::ExtendedValue &array = args[0];
4413   if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
4414     if (boxValue->hasAssumedRank())
4415       TODO(loc, "intrinsic: lbound with assumed rank argument");
4416
4417   //===----------------------------------------------------------------------===//
4418   mlir::Type indexType = builder.getIndexType();
4419
4420   // Semantics builds signatures for LBOUND calls as either
4421   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
4422   if (args.size() == 2 || isStaticallyAbsent(args, 1)) {
4423     // DIM is absent.
4424     mlir::Type lbType = fir::unwrapSequenceType(resultType);
4425     unsigned rank = array.rank();
4426     mlir::Type lbArrayType = fir::SequenceType::get(
4427         {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);
4428     mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);
4429     mlir::Type lbAddrType = builder.getRefType(lbType);
4430     mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);
4431     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
4432     for (unsigned dim = 0; dim < rank; ++dim) {
4433       mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);
4434       lb = builder.createConvert(loc, lbType, lb);
4435       auto index = builder.createIntegerConstant(loc, indexType, dim);
4436       auto lbAddr =
4437           builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index);
4438       builder.create<fir::StoreOp>(loc, lb, lbAddr);
4439     }
4440     mlir::Value lbArrayExtent =
4441         builder.createIntegerConstant(loc, indexType, rank);
4442     llvm::SmallVector<mlir::Value> extents{lbArrayExtent};
4443     return fir::ArrayBoxValue{lbArray, extents};
4444   }
4445   // DIM is present.
4446   mlir::Value dim = fir::getBase(args[1]);
4447
4448   // If it is a compile time constant, skip the runtime call.
4449   if (llvm::Optional<std::int64_t> cstDim =
4450           fir::factory::getIntIfConstant(dim)) {
4451     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
4452     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
4453     mlir::Value lb = computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
4454     return builder.createConvert(loc, resultType, lb);
4455   }
4456
4457   fir::ExtendedValue box = createBoxForRuntimeBoundInquiry(loc, builder, array);
4458   return builder.createConvert(
4459       loc, resultType,
4460       fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
4461 }
4462
4463 // UBOUND
4464 fir::ExtendedValue
4465 IntrinsicLibrary::genUbound(mlir::Type resultType,
4466                             llvm::ArrayRef<fir::ExtendedValue> args) {
4467   assert(args.size() == 3 || args.size() == 2);
4468   if (args.size() == 3) {
4469     // Handle calls to UBOUND with the DIM argument, which return a scalar
4470     mlir::Value extent = fir::getBase(genSize(resultType, args));
4471     mlir::Value lbound = fir::getBase(genLbound(resultType, args));
4472
4473     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
4474     mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
4475     return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
4476   } else {
4477     // Handle calls to UBOUND without the DIM argument, which return an array
4478     mlir::Value kind = isStaticallyAbsent(args[1])
4479                            ? builder.createIntegerConstant(
4480                                  loc, builder.getIndexType(),
4481                                  builder.getKindMap().defaultIntegerKind())
4482                            : fir::getBase(args[1]);
4483
4484     // Create mutable fir.box to be passed to the runtime for the result.
4485     mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
4486     fir::MutableBoxValue resultMutableBox =
4487         fir::factory::createTempMutableBox(builder, loc, type);
4488     mlir::Value resultIrBox =
4489         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4490
4491     fir::ExtendedValue box =
4492         createBoxForRuntimeBoundInquiry(loc, builder, args[0]);
4493     fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(box), kind);
4494
4495     return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
4496   }
4497   return mlir::Value();
4498 }
4499
4500 // SPACING
4501 mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
4502                                          llvm::ArrayRef<mlir::Value> args) {
4503   assert(args.size() == 1);
4504
4505   return builder.createConvert(
4506       loc, resultType,
4507       fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
4508 }
4509
4510 // SPREAD
4511 fir::ExtendedValue
4512 IntrinsicLibrary::genSpread(mlir::Type resultType,
4513                             llvm::ArrayRef<fir::ExtendedValue> args) {
4514
4515   assert(args.size() == 3);
4516
4517   // Handle source argument
4518   mlir::Value source = builder.createBox(loc, args[0]);
4519   fir::BoxValue sourceTmp = source;
4520   unsigned sourceRank = sourceTmp.rank();
4521
4522   // Handle Dim argument
4523   mlir::Value dim = fir::getBase(args[1]);
4524
4525   // Handle ncopies argument
4526   mlir::Value ncopies = fir::getBase(args[2]);
4527
4528   // Generate result descriptor
4529   mlir::Type resultArrayType =
4530       builder.getVarLenSeqTy(resultType, sourceRank + 1);
4531   fir::MutableBoxValue resultMutableBox =
4532       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4533   mlir::Value resultIrBox =
4534       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4535
4536   fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
4537
4538   return readAndAddCleanUp(resultMutableBox, resultType,
4539                            "unexpected result for SPREAD");
4540 }
4541
4542 // SUM
4543 fir::ExtendedValue
4544 IntrinsicLibrary::genSum(mlir::Type resultType,
4545                          llvm::ArrayRef<fir::ExtendedValue> args) {
4546   return genReduction(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
4547                       builder, loc, stmtCtx, "unexpected result for Sum", args);
4548 }
4549
4550 // SYSTEM_CLOCK
4551 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
4552   assert(args.size() == 3);
4553   Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
4554                                  fir::getBase(args[1]), fir::getBase(args[2]));
4555 }
4556
4557 // TRANSFER
4558 fir::ExtendedValue
4559 IntrinsicLibrary::genTransfer(mlir::Type resultType,
4560                               llvm::ArrayRef<fir::ExtendedValue> args) {
4561
4562   assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
4563
4564   // Handle source argument
4565   mlir::Value source = builder.createBox(loc, args[0]);
4566
4567   // Handle mold argument
4568   mlir::Value mold = builder.createBox(loc, args[1]);
4569   fir::BoxValue moldTmp = mold;
4570   unsigned moldRank = moldTmp.rank();
4571
4572   bool absentSize = (args.size() == 2);
4573
4574   // Create mutable fir.box to be passed to the runtime for the result.
4575   mlir::Type type = (moldRank == 0 && absentSize)
4576                         ? resultType
4577                         : builder.getVarLenSeqTy(resultType, 1);
4578   fir::MutableBoxValue resultMutableBox =
4579       fir::factory::createTempMutableBox(builder, loc, type);
4580
4581   if (moldRank == 0 && absentSize) {
4582     // This result is a scalar in this case.
4583     mlir::Value resultIrBox =
4584         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4585
4586     Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4587   } else {
4588     // The result is a rank one array in this case.
4589     mlir::Value resultIrBox =
4590         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4591
4592     if (absentSize) {
4593       Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4594     } else {
4595       mlir::Value sizeArg = fir::getBase(args[2]);
4596       Fortran::lower::genTransferSize(builder, loc, resultIrBox, source, mold,
4597                                       sizeArg);
4598     }
4599   }
4600   return readAndAddCleanUp(resultMutableBox, resultType,
4601                            "unexpected result for TRANSFER");
4602 }
4603
4604 // TRANSPOSE
4605 fir::ExtendedValue
4606 IntrinsicLibrary::genTranspose(mlir::Type resultType,
4607                                llvm::ArrayRef<fir::ExtendedValue> args) {
4608
4609   assert(args.size() == 1);
4610
4611   // Handle source argument
4612   mlir::Value source = builder.createBox(loc, args[0]);
4613
4614   // Create mutable fir.box to be passed to the runtime for the result.
4615   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
4616   fir::MutableBoxValue resultMutableBox =
4617       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4618   mlir::Value resultIrBox =
4619       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4620   // Call runtime. The runtime is allocating the result.
4621   fir::runtime::genTranspose(builder, loc, resultIrBox, source);
4622   // Read result from mutable fir.box and add it to the list of temps to be
4623   // finalized by the StatementContext.
4624   return readAndAddCleanUp(resultMutableBox, resultType,
4625                            "unexpected result for TRANSPOSE");
4626 }
4627
4628 // TRIM
4629 fir::ExtendedValue
4630 IntrinsicLibrary::genTrim(mlir::Type resultType,
4631                           llvm::ArrayRef<fir::ExtendedValue> args) {
4632   assert(args.size() == 1);
4633   mlir::Value string = builder.createBox(loc, args[0]);
4634   // Create mutable fir.box to be passed to the runtime for the result.
4635   fir::MutableBoxValue resultMutableBox =
4636       fir::factory::createTempMutableBox(builder, loc, resultType);
4637   mlir::Value resultIrBox =
4638       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4639   // Call runtime. The runtime is allocating the result.
4640   fir::runtime::genTrim(builder, loc, resultIrBox, string);
4641   // Read result from mutable fir.box and add it to the list of temps to be
4642   // finalized by the StatementContext.
4643   return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
4644 }
4645
4646 // Compare two FIR values and return boolean result as i1.
4647 template <Extremum extremum, ExtremumBehavior behavior>
4648 static mlir::Value createExtremumCompare(mlir::Location loc,
4649                                          fir::FirOpBuilder &builder,
4650                                          mlir::Value left, mlir::Value right) {
4651   static constexpr mlir::arith::CmpIPredicate integerPredicate =
4652       extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
4653                                 : mlir::arith::CmpIPredicate::slt;
4654   static constexpr mlir::arith::CmpFPredicate orderedCmp =
4655       extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
4656                                 : mlir::arith::CmpFPredicate::OLT;
4657   mlir::Type type = left.getType();
4658   mlir::Value result;
4659   if (fir::isa_real(type)) {
4660     // Note: the signaling/quit aspect of the result required by IEEE
4661     // cannot currently be obtained with LLVM without ad-hoc runtime.
4662     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
4663       // Return the number if one of the inputs is NaN and the other is
4664       // a number.
4665       auto leftIsResult =
4666           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4667       auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
4668           loc, mlir::arith::CmpFPredicate::UNE, right, right);
4669       result =
4670           builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
4671     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
4672       // Always return NaNs if one the input is NaNs
4673       auto leftIsResult =
4674           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4675       auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
4676           loc, mlir::arith::CmpFPredicate::UNE, left, left);
4677       result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
4678     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
4679       // If the left is a NaN, return the right whatever it is.
4680       result =
4681           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4682     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
4683       // If one of the operand is a NaN, return left whatever it is.
4684       static constexpr auto unorderedCmp =
4685           extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
4686                                     : mlir::arith::CmpFPredicate::ULT;
4687       result =
4688           builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
4689     } else {
4690       // TODO: ieeeMinNum/ieeeMaxNum
4691       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
4692                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
4693     }
4694   } else if (fir::isa_integer(type)) {
4695     result =
4696         builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
4697   } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
4698     // TODO: ! character min and max is tricky because the result
4699     // length is the length of the longest argument!
4700     // So we may need a temp.
4701     TODO(loc, "intrinsic: min and max for CHARACTER");
4702   }
4703   assert(result && "result must be defined");
4704   return result;
4705 }
4706
4707 // UNPACK
4708 fir::ExtendedValue
4709 IntrinsicLibrary::genUnpack(mlir::Type resultType,
4710                             llvm::ArrayRef<fir::ExtendedValue> args) {
4711   assert(args.size() == 3);
4712
4713   // Handle required vector argument
4714   mlir::Value vector = builder.createBox(loc, args[0]);
4715
4716   // Handle required mask argument
4717   fir::BoxValue maskBox = builder.createBox(loc, args[1]);
4718   mlir::Value mask = fir::getBase(maskBox);
4719   unsigned maskRank = maskBox.rank();
4720
4721   // Handle required field argument
4722   mlir::Value field = builder.createBox(loc, args[2]);
4723
4724   // Create mutable fir.box to be passed to the runtime for the result.
4725   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
4726   fir::MutableBoxValue resultMutableBox =
4727       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4728   mlir::Value resultIrBox =
4729       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4730
4731   fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
4732
4733   return readAndAddCleanUp(resultMutableBox, resultType,
4734                            "unexpected result for UNPACK");
4735 }
4736
4737 // VERIFY
4738 fir::ExtendedValue
4739 IntrinsicLibrary::genVerify(mlir::Type resultType,
4740                             llvm::ArrayRef<fir::ExtendedValue> args) {
4741
4742   assert(args.size() == 4);
4743
4744   if (isStaticallyAbsent(args[3])) {
4745     // Kind not specified, so call scan/verify runtime routine that is
4746     // specialized on the kind of characters in string.
4747
4748     // Handle required string base arg
4749     mlir::Value stringBase = fir::getBase(args[0]);
4750
4751     // Handle required set string base arg
4752     mlir::Value setBase = fir::getBase(args[1]);
4753
4754     // Handle kind argument; it is the kind of character in this case
4755     fir::KindTy kind =
4756         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
4757             stringBase.getType());
4758
4759     // Get string length argument
4760     mlir::Value stringLen = fir::getLen(args[0]);
4761
4762     // Get set string length argument
4763     mlir::Value setLen = fir::getLen(args[1]);
4764
4765     // Handle optional back argument
4766     mlir::Value back =
4767         isStaticallyAbsent(args[2])
4768             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
4769             : fir::getBase(args[2]);
4770
4771     return builder.createConvert(
4772         loc, resultType,
4773         fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
4774                                 setBase, setLen, back));
4775   }
4776   // else use the runtime descriptor version of scan/verify
4777
4778   // Handle optional argument, back
4779   auto makeRefThenEmbox = [&](mlir::Value b) {
4780     fir::LogicalType logTy = fir::LogicalType::get(
4781         builder.getContext(), builder.getKindMap().defaultLogicalKind());
4782     mlir::Value temp = builder.createTemporary(loc, logTy);
4783     mlir::Value castb = builder.createConvert(loc, logTy, b);
4784     builder.create<fir::StoreOp>(loc, castb, temp);
4785     return builder.createBox(loc, temp);
4786   };
4787   mlir::Value back = fir::isUnboxedValue(args[2])
4788                          ? makeRefThenEmbox(*args[2].getUnboxed())
4789                          : builder.create<fir::AbsentOp>(
4790                                loc, fir::BoxType::get(builder.getI1Type()));
4791
4792   // Handle required string argument
4793   mlir::Value string = builder.createBox(loc, args[0]);
4794
4795   // Handle required set argument
4796   mlir::Value set = builder.createBox(loc, args[1]);
4797
4798   // Handle kind argument
4799   mlir::Value kind = fir::getBase(args[3]);
4800
4801   // Create result descriptor
4802   fir::MutableBoxValue resultMutableBox =
4803       fir::factory::createTempMutableBox(builder, loc, resultType);
4804   mlir::Value resultIrBox =
4805       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4806
4807   fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
4808                                     back, kind);
4809
4810   // Handle cleanup of allocatable result descriptor and return
4811   return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
4812 }
4813
4814 // MAXLOC
4815 fir::ExtendedValue
4816 IntrinsicLibrary::genMaxloc(mlir::Type resultType,
4817                             llvm::ArrayRef<fir::ExtendedValue> args) {
4818   return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
4819                         resultType, builder, loc, stmtCtx,
4820                         "unexpected result for Maxloc", args);
4821 }
4822
4823 // MAXVAL
4824 fir::ExtendedValue
4825 IntrinsicLibrary::genMaxval(mlir::Type resultType,
4826                             llvm::ArrayRef<fir::ExtendedValue> args) {
4827   return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
4828                         fir::runtime::genMaxvalChar, resultType, builder, loc,
4829                         stmtCtx, "unexpected result for Maxval", args);
4830 }
4831
4832 // MINLOC
4833 fir::ExtendedValue
4834 IntrinsicLibrary::genMinloc(mlir::Type resultType,
4835                             llvm::ArrayRef<fir::ExtendedValue> args) {
4836   return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
4837                         resultType, builder, loc, stmtCtx,
4838                         "unexpected result for Minloc", args);
4839 }
4840
4841 // MINVAL
4842 fir::ExtendedValue
4843 IntrinsicLibrary::genMinval(mlir::Type resultType,
4844                             llvm::ArrayRef<fir::ExtendedValue> args) {
4845   return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
4846                         fir::runtime::genMinvalChar, resultType, builder, loc,
4847                         stmtCtx, "unexpected result for Minval", args);
4848 }
4849
4850 // MIN and MAX
4851 template <Extremum extremum, ExtremumBehavior behavior>
4852 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
4853                                           llvm::ArrayRef<mlir::Value> args) {
4854   assert(args.size() >= 1);
4855   mlir::Value result = args[0];
4856   for (auto arg : args.drop_front()) {
4857     mlir::Value mask =
4858         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
4859     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
4860   }
4861   return result;
4862 }
4863
4864 //===----------------------------------------------------------------------===//
4865 // Argument lowering rules interface for intrinsic or intrinsic module
4866 // procedure.
4867 //===----------------------------------------------------------------------===//
4868
4869 const Fortran::lower::IntrinsicArgumentLoweringRules *
4870 Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef specificName) {
4871   llvm::StringRef name = genericName(specificName);
4872   if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
4873     if (!handler->argLoweringRules.hasDefaultRules())
4874       return &handler->argLoweringRules;
4875   return nullptr;
4876 }
4877
4878 /// Return how argument \p argName should be lowered given the rules for the
4879 /// intrinsic function.
4880 Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
4881     const IntrinsicArgumentLoweringRules &rules, unsigned position) {
4882   assert(position < sizeof(rules.args) / sizeof(decltype(*rules.args)) &&
4883          "invalid argument");
4884   return {rules.args[position].lowerAs,
4885           rules.args[position].handleDynamicOptional};
4886 }
4887
4888 //===----------------------------------------------------------------------===//
4889 // Public intrinsic call helpers
4890 //===----------------------------------------------------------------------===//
4891
4892 fir::ExtendedValue
4893 Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
4894                                  llvm::StringRef name,
4895                                  llvm::Optional<mlir::Type> resultType,
4896                                  llvm::ArrayRef<fir::ExtendedValue> args,
4897                                  Fortran::lower::StatementContext &stmtCtx) {
4898   return IntrinsicLibrary{builder, loc, &stmtCtx}.genIntrinsicCall(
4899       name, resultType, args);
4900 }
4901
4902 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
4903                                    mlir::Location loc,
4904                                    llvm::ArrayRef<mlir::Value> args) {
4905   assert(args.size() > 0 && "max requires at least one argument");
4906   return IntrinsicLibrary{builder, loc}
4907       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
4908                                                               args);
4909 }
4910
4911 mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder,
4912                                    mlir::Location loc,
4913                                    llvm::ArrayRef<mlir::Value> args) {
4914   assert(args.size() > 0 && "min requires at least one argument");
4915   return IntrinsicLibrary{builder, loc}
4916       .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
4917                                                               args);
4918 }
4919
4920 mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
4921                                    mlir::Location loc, mlir::Type type,
4922                                    mlir::Value x, mlir::Value y) {
4923   // TODO: since there is no libm version of pow with integer exponent,
4924   //       we have to provide an alternative implementation for
4925   //       "precise/strict" FP mode.
4926   //       One option is to generate internal function with inlined
4927   //       implementation and mark it 'strictfp'.
4928   //       Another option is to implement it in Fortran runtime library
4929   //       (just like matmul).
4930   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
4931 }
4932
4933 mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
4934     fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
4935     mlir::FunctionType signature) {
4936   return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
4937       name, signature);
4938 }