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