• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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 "RTBuilder.h"
18 #include "flang/Common/static-multimap-view.h"
19 #include "flang/Lower/CharacterExpr.h"
20 #include "flang/Lower/ComplexExpr.h"
21 #include "flang/Lower/ConvertType.h"
22 #include "flang/Lower/FIRBuilder.h"
23 #include "flang/Lower/Mangler.h"
24 #include "flang/Lower/Runtime.h"
25 #include "llvm/Support/CommandLine.h"
26 #include "llvm/Support/ErrorHandling.h"
27 #include <algorithm>
28 #include <string_view>
29 #include <utility>
30 
31 #define PGMATH_DECLARE
32 #include "../runtime/pgmath.h.inc"
33 
34 /// This file implements lowering of Fortran intrinsic procedures.
35 /// Intrinsics are lowered to a mix of FIR and MLIR operations as
36 /// well as call to runtime functions or LLVM intrinsics.
37 
38 /// Lowering of intrinsic procedure calls is based on a map that associates
39 /// Fortran intrinsic generic names to FIR generator functions.
40 /// All generator functions are member functions of the IntrinsicLibrary class
41 /// and have the same interface.
42 /// If no generator is given for an intrinsic name, a math runtime library
43 /// is searched for an implementation and, if a runtime function is found,
44 /// a call is generated for it. LLVM intrinsics are handled as a math
45 /// runtime library here.
46 
47 /// Enums used to templatize and share lowering of MIN and MAX.
48 enum class Extremum { Min, Max };
49 
50 // There are different ways to deal with NaNs in MIN and MAX.
51 // Known existing behaviors are listed below and can be selected for
52 // f18 MIN/MAX implementation.
53 enum class ExtremumBehavior {
54   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
55   // not described because there is no way to control/observe such aspect in
56   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
57   // aspect that are therefore currently not enforced. In the descriptions
58   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
59   // if one of the input NaN was signaling but it cannot be guaranteed either.
60   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
61   // signaling/quiet requirements.
62   IeeeMinMaximumNumber,
63   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
64   // If one of the argument is and number and the other is NaN, return the
65   // number. If both arguements are NaN, return NaN.
66   // Compilers: gfortran.
67   IeeeMinMaximum,
68   // IEEE minimum/maximum behavior (754-2019, section 9.6):
69   // If one of the argument is NaN, return NaN.
70   MinMaxss,
71   // x86 minss/maxss behavior:
72   // If the second argument is a number and the other is NaN, return the number.
73   // In all other cases where at least one operand is NaN, return NaN.
74   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
75   PgfortranLlvm,
76   // "Opposite of" x86 minss/maxss behavior:
77   // If the first argument is a number and the other is NaN, return the
78   // number.
79   // In all other cases where at least one operand is NaN, return NaN.
80   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
81   IeeeMinMaxNum
82   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
83   // TODO: Not implemented.
84   // It is the only behavior where the signaling/quiet aspect of a NaN argument
85   // impacts if the result should be NaN or the argument that is a number.
86   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
87   // possible to implement it without some target dependent runtime.
88 };
89 
90 // TODO error handling -> return a code or directly emit messages ?
91 struct IntrinsicLibrary {
92 
93   // Constructors.
IntrinsicLibraryIntrinsicLibrary94   explicit IntrinsicLibrary(Fortran::lower::FirOpBuilder &builder,
95                             mlir::Location loc)
96       : builder{builder}, loc{loc} {}
97   IntrinsicLibrary() = delete;
98   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
99 
100   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
101   /// and expected result type \p resultType.
102   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
103                                       mlir::Type resultType,
104                                       llvm::ArrayRef<fir::ExtendedValue> arg);
105 
106   /// Search a runtime function that is associated to the generic intrinsic name
107   /// and whose signature matches the intrinsic arguments and result types.
108   /// If no such runtime function is found but a runtime function associated
109   /// with the Fortran generic exists and has the same number of arguments,
110   /// conversions will be inserted before and/or after the call. This is to
111   /// mainly to allow 16 bits float support even-though little or no math
112   /// runtime is currently available for it.
113   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
114                              llvm::ArrayRef<mlir::Value>);
115 
116   using RuntimeCallGenerator =
117       std::function<mlir::Value(Fortran::lower::FirOpBuilder &, mlir::Location,
118                                 llvm::ArrayRef<mlir::Value>)>;
119   RuntimeCallGenerator
120   getRuntimeCallGenerator(llvm::StringRef name,
121                           mlir::FunctionType soughtFuncType);
122 
123   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
124   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
125   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
126   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
127   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
128   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
129   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
130   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
131   template <Extremum, ExtremumBehavior>
132   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
133   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
134   mlir::Value genIAnd(mlir::Type, llvm::ArrayRef<mlir::Value>);
135   mlir::Value genIchar(mlir::Type, llvm::ArrayRef<mlir::Value>);
136   mlir::Value genIEOr(mlir::Type, llvm::ArrayRef<mlir::Value>);
137   mlir::Value genIOr(mlir::Type, llvm::ArrayRef<mlir::Value>);
138   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
139   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
140   mlir::Value genMerge(mlir::Type, llvm::ArrayRef<mlir::Value>);
141   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
142   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
143   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
144   /// Implement all conversion functions like DBLE, the first argument is
145   /// the value to convert. There may be an additional KIND arguments that
146   /// is ignored because this is already reflected in the result type.
147   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
148 
149   /// Define the different FIR generators that can be mapped to intrinsic to
150   /// generate the related code.
151   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
152   using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
153   using Generator = std::variant<ElementalGenerator, ExtendedGenerator>;
154 
155   /// All generators can be outlined. This will build a function named
156   /// "fir."+ <generic name> + "." + <result type code> and generate the
157   /// intrinsic implementation inside instead of at the intrinsic call sites.
158   /// This can be used to keep the FIR more readable. Only one function will
159   /// be generated for all the similar calls in a program.
160   /// If the Generator is nullptr, the wrapper uses genRuntimeCall.
161   template <typename GeneratorType>
162   mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name,
163                                mlir::Type resultType,
164                                llvm::ArrayRef<mlir::Value> args);
165   fir::ExtendedValue outlineInWrapper(ExtendedGenerator, llvm::StringRef name,
166                                       mlir::Type resultType,
167                                       llvm::ArrayRef<fir::ExtendedValue> args);
168 
169   template <typename GeneratorType>
170   mlir::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
171                           mlir::FunctionType, bool loadRefArguments = false);
172 
173   /// Generate calls to ElementalGenerator, handling the elemental aspects
174   template <typename GeneratorType>
175   fir::ExtendedValue
176   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
177                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
178 
179   /// Helper to invoke code generator for the intrinsics given arguments.
180   mlir::Value invokeGenerator(ElementalGenerator generator,
181                               mlir::Type resultType,
182                               llvm::ArrayRef<mlir::Value> args);
183   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
184                               mlir::Type resultType,
185                               llvm::ArrayRef<mlir::Value> args);
186   mlir::Value invokeGenerator(ExtendedGenerator generator,
187                               mlir::Type resultType,
188                               llvm::ArrayRef<mlir::Value> args);
189 
190   /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
191   /// intrinsic if it is not defined yet.
192   mlir::SymbolRefAttr
193   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
194                                         mlir::FunctionType signature);
195 
196   Fortran::lower::FirOpBuilder &builder;
197   mlir::Location loc;
198 };
199 
200 /// Table that drives the fir generation depending on the intrinsic.
201 /// one to one mapping with Fortran arguments. If no mapping is
202 /// defined here for a generic intrinsic, genRuntimeCall will be called
203 /// to look for a match in the runtime a emit a call.
204 struct IntrinsicHandler {
205   const char *name;
206   IntrinsicLibrary::Generator generator;
207   bool isElemental = true;
208   /// Code heavy intrinsic can be outlined to make FIR
209   /// more readable.
210   bool outline = false;
211 };
212 using I = IntrinsicLibrary;
213 static constexpr IntrinsicHandler handlers[]{
214     {"abs", &I::genAbs},
215     {"achar", &I::genConversion},
216     {"aimag", &I::genAimag},
217     {"aint", &I::genAint},
218     {"anint", &I::genAnint},
219     {"ceiling", &I::genCeiling},
220     {"char", &I::genConversion},
221     {"conjg", &I::genConjg},
222     {"dim", &I::genDim},
223     {"dble", &I::genConversion},
224     {"dprod", &I::genDprod},
225     {"floor", &I::genFloor},
226     {"iand", &I::genIAnd},
227     {"ichar", &I::genIchar},
228     {"ieor", &I::genIEOr},
229     {"ior", &I::genIOr},
230     {"len", &I::genLen},
231     {"len_trim", &I::genLenTrim},
232     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
233     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
234     {"merge", &I::genMerge},
235     {"mod", &I::genMod},
236     {"nint", &I::genNint},
237     {"sign", &I::genSign},
238 };
239 
240 /// To make fir output more readable for debug, one can outline all intrinsic
241 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
242 static llvm::cl::opt<bool> outlineAllIntrinsics(
243     "outline-intrinsics",
244     llvm::cl::desc(
245         "Lower all intrinsic procedure implementation in their own functions"),
246     llvm::cl::init(false));
247 
248 //===----------------------------------------------------------------------===//
249 // Math runtime description and matching utility
250 //===----------------------------------------------------------------------===//
251 
252 /// Command line option to modify math runtime version used to implement
253 /// intrinsics.
254 enum MathRuntimeVersion {
255   fastVersion,
256   relaxedVersion,
257   preciseVersion,
258   llvmOnly
259 };
260 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
261     "math-runtime", llvm::cl::desc("Select math runtime version:"),
262     llvm::cl::values(
263         clEnumValN(fastVersion, "fast", "use pgmath fast runtime"),
264         clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"),
265         clEnumValN(preciseVersion, "precise", "use pgmath precise runtime"),
266         clEnumValN(llvmOnly, "llvm",
267                    "only use LLVM intrinsics (may be incomplete)")),
268     llvm::cl::init(fastVersion));
269 
270 struct RuntimeFunction {
271   // llvm::StringRef comparison operator are not constexpr, so use string_view.
272   using Key = std::string_view;
273   // Needed for implicit compare with keys.
operator KeyRuntimeFunction274   constexpr operator Key() const { return key; }
275   Key key; // intrinsic name
276   llvm::StringRef symbol;
277   Fortran::lower::FuncTypeBuilderFunc typeGenerator;
278 };
279 
280 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
281   {#name, #func,                                                               \
282    Fortran::lower::RuntimeTableKey<decltype(func)>::getTypeModel()},
283 static constexpr RuntimeFunction pgmathFast[] = {
284 #define PGMATH_FAST
285 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
286 #include "../runtime/pgmath.h.inc"
287 };
288 static constexpr RuntimeFunction pgmathRelaxed[] = {
289 #define PGMATH_RELAXED
290 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
291 #include "../runtime/pgmath.h.inc"
292 };
293 static constexpr RuntimeFunction pgmathPrecise[] = {
294 #define PGMATH_PRECISE
295 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
296 #include "../runtime/pgmath.h.inc"
297 };
298 
genF32F32FuncType(mlir::MLIRContext * context)299 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
300   auto t = mlir::FloatType::getF32(context);
301   return mlir::FunctionType::get({t}, {t}, context);
302 }
303 
genF64F64FuncType(mlir::MLIRContext * context)304 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
305   auto t = mlir::FloatType::getF64(context);
306   return mlir::FunctionType::get({t}, {t}, context);
307 }
308 
309 template <int Bits>
genIntF64FuncType(mlir::MLIRContext * context)310 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
311   auto t = mlir::FloatType::getF64(context);
312   auto r = mlir::IntegerType::get(Bits, context);
313   return mlir::FunctionType::get({t}, {r}, context);
314 }
315 
316 template <int Bits>
genIntF32FuncType(mlir::MLIRContext * context)317 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
318   auto t = mlir::FloatType::getF32(context);
319   auto r = mlir::IntegerType::get(Bits, context);
320   return mlir::FunctionType::get({t}, {r}, context);
321 }
322 
323 // TODO : Fill-up this table with more intrinsic.
324 // Note: These are also defined as operations in LLVM dialect. See if this
325 // can be use and has advantages.
326 static constexpr RuntimeFunction llvmIntrinsics[] = {
327     {"abs", "llvm.fabs.f32", genF32F32FuncType},
328     {"abs", "llvm.fabs.f64", genF64F64FuncType},
329     {"aint", "llvm.trunc.f32", genF32F32FuncType},
330     {"aint", "llvm.trunc.f64", genF64F64FuncType},
331     {"anint", "llvm.round.f32", genF32F32FuncType},
332     {"anint", "llvm.round.f64", genF64F64FuncType},
333     // ceil is used for CEILING but is different, it returns a real.
334     {"ceil", "llvm.ceil.f32", genF32F32FuncType},
335     {"ceil", "llvm.ceil.f64", genF64F64FuncType},
336     {"cos", "llvm.cos.f32", genF32F32FuncType},
337     {"cos", "llvm.cos.f64", genF64F64FuncType},
338     // llvm.floor is used for FLOOR, but returns real.
339     {"floor", "llvm.floor.f32", genF32F32FuncType},
340     {"floor", "llvm.floor.f64", genF64F64FuncType},
341     {"log", "llvm.log.f32", genF32F32FuncType},
342     {"log", "llvm.log.f64", genF64F64FuncType},
343     {"log10", "llvm.log10.f32", genF32F32FuncType},
344     {"log10", "llvm.log10.f64", genF64F64FuncType},
345     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>},
346     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>},
347     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>},
348     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>},
349     {"sin", "llvm.sin.f32", genF32F32FuncType},
350     {"sin", "llvm.sin.f64", genF64F64FuncType},
351     {"sqrt", "llvm.sqrt.f32", genF32F32FuncType},
352     {"sqrt", "llvm.sqrt.f64", genF64F64FuncType},
353 };
354 
355 // This helper class computes a "distance" between two function types.
356 // The distance measures how many narrowing conversions of actual arguments
357 // and result of "from" must be made in order to use "to" instead of "from".
358 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
359 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
360 // if no implementation of ACOS(REAL(10)) is available, it is better to use
361 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
362 // Note that this is not a symmetric distance and the order of "from" and "to"
363 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
364 // may be safe to replace foo by bar, but not the opposite.
365 class FunctionDistance {
366 public:
FunctionDistance()367   FunctionDistance() : infinite{true} {}
368 
FunctionDistance(mlir::FunctionType from,mlir::FunctionType to)369   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
370     auto nInputs = from.getNumInputs();
371     auto nResults = from.getNumResults();
372     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
373       infinite = true;
374     } else {
375       for (decltype(nInputs) i{0}; i < nInputs && !infinite; ++i)
376         addArgumentDistance(from.getInput(i), to.getInput(i));
377       for (decltype(nResults) i{0}; i < nResults && !infinite; ++i)
378         addResultDistance(to.getResult(i), from.getResult(i));
379     }
380   }
381 
382   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
383   /// false if both d1 and d2 are infinite. This implies that
384   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
isSmallerThan(const FunctionDistance & d) const385   bool isSmallerThan(const FunctionDistance &d) const {
386     return !infinite &&
387            (d.infinite || std::lexicographical_compare(
388                               conversions.begin(), conversions.end(),
389                               d.conversions.begin(), d.conversions.end()));
390   }
391 
isLosingPrecision() const392   bool isLosingPrecision() const {
393     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
394   }
395 
isInfinite() const396   bool isInfinite() const { return infinite; }
397 
398 private:
399   enum class Conversion { Forbidden, None, Narrow, Extend };
400 
addArgumentDistance(mlir::Type from,mlir::Type to)401   void addArgumentDistance(mlir::Type from, mlir::Type to) {
402     switch (conversionBetweenTypes(from, to)) {
403     case Conversion::Forbidden:
404       infinite = true;
405       break;
406     case Conversion::None:
407       break;
408     case Conversion::Narrow:
409       conversions[narrowingArg]++;
410       break;
411     case Conversion::Extend:
412       conversions[nonNarrowingArg]++;
413       break;
414     }
415   }
416 
addResultDistance(mlir::Type from,mlir::Type to)417   void addResultDistance(mlir::Type from, mlir::Type to) {
418     switch (conversionBetweenTypes(from, to)) {
419     case Conversion::Forbidden:
420       infinite = true;
421       break;
422     case Conversion::None:
423       break;
424     case Conversion::Narrow:
425       conversions[nonExtendingResult]++;
426       break;
427     case Conversion::Extend:
428       conversions[extendingResult]++;
429       break;
430     }
431   }
432 
433   // Floating point can be mlir::FloatType or fir::real
getFloatingPointWidth(mlir::Type t)434   static unsigned getFloatingPointWidth(mlir::Type t) {
435     if (auto f{t.dyn_cast<mlir::FloatType>()})
436       return f.getWidth();
437     // FIXME: Get width another way for fir.real/complex
438     // - use fir/KindMapping.h and llvm::Type
439     // - or use evaluate/type.h
440     if (auto r{t.dyn_cast<fir::RealType>()})
441       return r.getFKind() * 4;
442     if (auto cplx{t.dyn_cast<fir::CplxType>()})
443       return cplx.getFKind() * 4;
444     llvm_unreachable("not a floating-point type");
445   }
446 
conversionBetweenTypes(mlir::Type from,mlir::Type to)447   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
448     if (from == to) {
449       return Conversion::None;
450     }
451     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
452       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
453         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
454                                                          : Conversion::Extend;
455       }
456     }
457     if (fir::isa_real(from) && fir::isa_real(to)) {
458       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
459                  ? Conversion::Narrow
460                  : Conversion::Extend;
461     }
462     if (auto fromCplxTy{from.dyn_cast<fir::CplxType>()}) {
463       if (auto toCplxTy{to.dyn_cast<fir::CplxType>()}) {
464         return getFloatingPointWidth(fromCplxTy) >
465                        getFloatingPointWidth(toCplxTy)
466                    ? Conversion::Narrow
467                    : Conversion::Extend;
468       }
469     }
470     // Notes:
471     // - No conversion between character types, specialization of runtime
472     // functions should be made instead.
473     // - It is not clear there is a use case for automatic conversions
474     // around Logical and it may damage hidden information in the physical
475     // storage so do not do it.
476     return Conversion::Forbidden;
477   }
478 
479   // Below are indexes to access data in conversions.
480   // The order in data does matter for lexicographical_compare
481   enum {
482     narrowingArg = 0,   // usually bad
483     extendingResult,    // usually bad
484     nonExtendingResult, // usually ok
485     nonNarrowingArg,    // usually ok
486     dataSize
487   };
488 
489   std::array<int, dataSize> conversions{/* zero init*/};
490   bool infinite{false}; // When forbidden conversion or wrong argument number
491 };
492 
493 /// Build mlir::FuncOp from runtime symbol description and add
494 /// fir.runtime attribute.
getFuncOp(mlir::Location loc,Fortran::lower::FirOpBuilder & builder,const RuntimeFunction & runtime)495 static mlir::FuncOp getFuncOp(mlir::Location loc,
496                               Fortran::lower::FirOpBuilder &builder,
497                               const RuntimeFunction &runtime) {
498   auto function = builder.addNamedFunction(
499       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
500   function.setAttr("fir.runtime", builder.getUnitAttr());
501   return function;
502 }
503 
504 /// Select runtime function that has the smallest distance to the intrinsic
505 /// function type and that will not imply narrowing arguments or extending the
506 /// result.
507 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
searchFunctionInLibrary(mlir::Location loc,Fortran::lower::FirOpBuilder & builder,const Fortran::common::StaticMultimapView<RuntimeFunction> & lib,llvm::StringRef name,mlir::FunctionType funcType,const RuntimeFunction ** bestNearMatch,FunctionDistance & bestMatchDistance)508 mlir::FuncOp searchFunctionInLibrary(
509     mlir::Location loc, Fortran::lower::FirOpBuilder &builder,
510     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
511     llvm::StringRef name, mlir::FunctionType funcType,
512     const RuntimeFunction **bestNearMatch,
513     FunctionDistance &bestMatchDistance) {
514   auto range = lib.equal_range(name);
515   for (auto iter{range.first}; iter != range.second && iter; ++iter) {
516     const auto &impl = *iter;
517     auto implType = impl.typeGenerator(builder.getContext());
518     if (funcType == implType) {
519       return getFuncOp(loc, builder, impl); // exact match
520     } else {
521       FunctionDistance distance(funcType, implType);
522       if (distance.isSmallerThan(bestMatchDistance)) {
523         *bestNearMatch = &impl;
524         bestMatchDistance = std::move(distance);
525       }
526     }
527   }
528   return {};
529 }
530 
531 /// Search runtime for the best runtime function given an intrinsic name
532 /// and interface. The interface may not be a perfect match in which case
533 /// the caller is responsible to insert argument and return value conversions.
534 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
getRuntimeFunction(mlir::Location loc,Fortran::lower::FirOpBuilder & builder,llvm::StringRef name,mlir::FunctionType funcType)535 static mlir::FuncOp getRuntimeFunction(mlir::Location loc,
536                                        Fortran::lower::FirOpBuilder &builder,
537                                        llvm::StringRef name,
538                                        mlir::FunctionType funcType) {
539   const RuntimeFunction *bestNearMatch = nullptr;
540   FunctionDistance bestMatchDistance{};
541   mlir::FuncOp match;
542   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
543   static constexpr RtMap pgmathF(pgmathFast);
544   static_assert(pgmathF.Verify() && "map must be sorted");
545   static constexpr RtMap pgmathR(pgmathRelaxed);
546   static_assert(pgmathR.Verify() && "map must be sorted");
547   static constexpr RtMap pgmathP(pgmathPrecise);
548   static_assert(pgmathP.Verify() && "map must be sorted");
549   if (mathRuntimeVersion == fastVersion) {
550     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
551                                     &bestNearMatch, bestMatchDistance);
552   } else if (mathRuntimeVersion == relaxedVersion) {
553     match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType,
554                                     &bestNearMatch, bestMatchDistance);
555   } else if (mathRuntimeVersion == preciseVersion) {
556     match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType,
557                                     &bestNearMatch, bestMatchDistance);
558   } else {
559     assert(mathRuntimeVersion == llvmOnly && "unknown math runtime");
560   }
561   if (match)
562     return match;
563 
564   // Go through llvm intrinsics if not exact match in libpgmath or if
565   // mathRuntimeVersion == llvmOnly
566   static constexpr RtMap llvmIntr(llvmIntrinsics);
567   static_assert(llvmIntr.Verify() && "map must be sorted");
568   if (auto exactMatch =
569           searchFunctionInLibrary(loc, builder, llvmIntr, name, funcType,
570                                   &bestNearMatch, bestMatchDistance))
571     return exactMatch;
572 
573   if (bestNearMatch != nullptr) {
574     assert(!bestMatchDistance.isLosingPrecision() &&
575            "runtime selection loses precision");
576     return getFuncOp(loc, builder, *bestNearMatch);
577   }
578   return {};
579 }
580 
581 /// Helpers to get function type from arguments and result type.
582 static mlir::FunctionType
getFunctionType(mlir::Type resultType,llvm::ArrayRef<mlir::Value> arguments,Fortran::lower::FirOpBuilder & builder)583 getFunctionType(mlir::Type resultType, llvm::ArrayRef<mlir::Value> arguments,
584                 Fortran::lower::FirOpBuilder &builder) {
585   llvm::SmallVector<mlir::Type, 2> argumentTypes;
586   for (auto &arg : arguments)
587     argumentTypes.push_back(arg.getType());
588   return mlir::FunctionType::get(argumentTypes, resultType,
589                                  builder.getModule().getContext());
590 }
591 
592 /// fir::ExtendedValue to mlir::Value translation layer
593 
toExtendedValue(mlir::Value val,Fortran::lower::FirOpBuilder & builder,mlir::Location loc)594 fir::ExtendedValue toExtendedValue(mlir::Value val,
595                                    Fortran::lower::FirOpBuilder &builder,
596                                    mlir::Location loc) {
597   assert(val && "optional unhandled here");
598   auto type = val.getType();
599   auto base = val;
600   auto indexType = builder.getIndexType();
601   llvm::SmallVector<mlir::Value, 2> extents;
602 
603   Fortran::lower::CharacterExprHelper charHelper{builder, loc};
604   if (charHelper.isCharacter(type))
605     return charHelper.toExtendedValue(val);
606 
607   if (auto refType = type.dyn_cast<fir::ReferenceType>())
608     type = refType.getEleTy();
609 
610   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
611     type = arrayType.getEleTy();
612     for (auto extent : arrayType.getShape()) {
613       if (extent == fir::SequenceType::getUnknownExtent())
614         break;
615       extents.emplace_back(
616           builder.createIntegerConstant(loc, indexType, extent));
617     }
618     // Last extent might be missing in case of assumed-size. If more extents
619     // could not be deduced from type, that's an error (a fir.box should
620     // have been used in the interface).
621     if (extents.size() + 1 < arrayType.getShape().size())
622       mlir::emitError(loc, "cannot retrieve array extents from type");
623   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
624     mlir::emitError(loc, "descriptor or derived type not yet handled");
625   }
626 
627   if (!extents.empty())
628     return fir::ArrayBoxValue{base, extents};
629   return base;
630 }
631 
toValue(const fir::ExtendedValue & val,Fortran::lower::FirOpBuilder & builder,mlir::Location loc)632 mlir::Value toValue(const fir::ExtendedValue &val,
633                     Fortran::lower::FirOpBuilder &builder, mlir::Location loc) {
634   if (auto charBox = val.getCharBox()) {
635     auto buffer = charBox->getBuffer();
636     if (buffer.getType().isa<fir::BoxCharType>())
637       return buffer;
638     return Fortran::lower::CharacterExprHelper{builder, loc}.createEmboxChar(
639         buffer, charBox->getLen());
640   }
641 
642   // FIXME: need to access other ExtendedValue variants and handle them
643   // properly.
644   return fir::getBase(val);
645 }
646 
647 //===----------------------------------------------------------------------===//
648 // IntrinsicLibrary
649 //===----------------------------------------------------------------------===//
650 
651 template <typename GeneratorType>
genElementalCall(GeneratorType generator,llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args,bool outline)652 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
653     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
654     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
655   llvm::SmallVector<mlir::Value, 2> scalarArgs;
656   for (const auto &arg : args) {
657     if (arg.getUnboxed() || arg.getCharBox()) {
658       scalarArgs.emplace_back(fir::getBase(arg));
659     } else {
660       // TODO: get the result shape and create the loop...
661       mlir::emitError(loc, "array or descriptor not yet handled in elemental "
662                            "intrinsic lowering");
663       exit(1);
664     }
665   }
666   if (outline)
667     return outlineInWrapper(generator, name, resultType, scalarArgs);
668   return invokeGenerator(generator, resultType, scalarArgs);
669 }
670 
671 /// Some ExtendedGenerator operating on characters are also elemental
672 /// (e.g LEN_TRIM).
673 template <>
674 fir::ExtendedValue
genElementalCall(ExtendedGenerator generator,llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args,bool outline)675 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
676     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
677     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
678   for (const auto &arg : args)
679     if (!arg.getUnboxed() && !arg.getCharBox()) {
680       // TODO: get the result shape and create the loop...
681       mlir::emitError(loc, "array or descriptor not yet handled in elemental "
682                            "intrinsic lowering");
683       exit(1);
684     }
685   if (outline)
686     return outlineInWrapper(generator, name, resultType, args);
687   return std::invoke(generator, *this, resultType, args);
688 }
689 
690 fir::ExtendedValue
genIntrinsicCall(llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args)691 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType,
692                                    llvm::ArrayRef<fir::ExtendedValue> args) {
693   for (auto &handler : handlers)
694     if (name == handler.name) {
695       bool outline = handler.outline || outlineAllIntrinsics;
696       if (const auto *elementalGenerator =
697               std::get_if<ElementalGenerator>(&handler.generator))
698         return genElementalCall(*elementalGenerator, name, resultType, args,
699                                 outline);
700       const auto &generator = std::get<ExtendedGenerator>(handler.generator);
701       if (handler.isElemental)
702         return genElementalCall(generator, name, resultType, args, outline);
703       if (outline)
704         return outlineInWrapper(generator, name, resultType, args);
705       return std::invoke(generator, *this, resultType, args);
706     }
707 
708   // Try the runtime if no special handler was defined for the
709   // intrinsic being called. Maths runtime only has numerical elemental.
710   // No optional arguments are expected at this point, the code will
711   // crash if it gets absent optional.
712 
713   // FIXME: using toValue to get the type won't work with array arguments.
714   llvm::SmallVector<mlir::Value, 2> mlirArgs;
715   for (const auto &extendedVal : args) {
716     auto val = toValue(extendedVal, builder, loc);
717     if (!val) {
718       // If an absent optional gets there, most likely its handler has just
719       // not yet been defined.
720       mlir::emitError(loc,
721                       "TODO: missing intrinsic lowering: " + llvm::Twine(name));
722       exit(1);
723     }
724     mlirArgs.emplace_back(val);
725   }
726   mlir::FunctionType soughtFuncType =
727       getFunctionType(resultType, mlirArgs, builder);
728 
729   auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType);
730   return genElementalCall(runtimeCallGenerator, name, resultType, args,
731                           /* outline */ true);
732 }
733 
734 mlir::Value
invokeGenerator(ElementalGenerator generator,mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)735 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
736                                   mlir::Type resultType,
737                                   llvm::ArrayRef<mlir::Value> args) {
738   return std::invoke(generator, *this, resultType, args);
739 }
740 
741 mlir::Value
invokeGenerator(RuntimeCallGenerator generator,mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)742 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
743                                   mlir::Type resultType,
744                                   llvm::ArrayRef<mlir::Value> args) {
745   return generator(builder, loc, args);
746 }
747 
748 mlir::Value
invokeGenerator(ExtendedGenerator generator,mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)749 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
750                                   mlir::Type resultType,
751                                   llvm::ArrayRef<mlir::Value> args) {
752   llvm::SmallVector<fir::ExtendedValue, 2> extendedArgs;
753   for (auto arg : args)
754     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
755   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
756   return toValue(extendedResult, builder, loc);
757 }
758 
759 template <typename GeneratorType>
getWrapper(GeneratorType generator,llvm::StringRef name,mlir::FunctionType funcType,bool loadRefArguments)760 mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
761                                           llvm::StringRef name,
762                                           mlir::FunctionType funcType,
763                                           bool loadRefArguments) {
764   assert(funcType.getNumResults() == 1 &&
765          "expect one result for intrinsic functions");
766   auto resultType = funcType.getResult(0);
767   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
768   auto function = builder.getNamedFunction(wrapperName);
769   if (!function) {
770     // First time this wrapper is needed, build it.
771     function = builder.createFunction(loc, wrapperName, funcType);
772     function.setAttr("fir.intrinsic", builder.getUnitAttr());
773     function.addEntryBlock();
774 
775     // Create local context to emit code into the newly created function
776     // This new function is not linked to a source file location, only
777     // its calls will be.
778     auto localBuilder = std::make_unique<Fortran::lower::FirOpBuilder>(
779         function, builder.getKindMap());
780     localBuilder->setInsertionPointToStart(&function.front());
781     // Location of code inside wrapper of the wrapper is independent from
782     // the location of the intrinsic call.
783     auto localLoc = localBuilder->getUnknownLoc();
784     llvm::SmallVector<mlir::Value, 2> localArguments;
785     for (mlir::BlockArgument bArg : function.front().getArguments()) {
786       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
787       if (loadRefArguments && refType) {
788         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
789         localArguments.push_back(loaded);
790       } else {
791         localArguments.push_back(bArg);
792       }
793     }
794 
795     IntrinsicLibrary localLib{*localBuilder, localLoc};
796     auto result =
797         localLib.invokeGenerator(generator, resultType, localArguments);
798     localBuilder->create<mlir::ReturnOp>(localLoc, result);
799   } else {
800     // Wrapper was already built, ensure it has the sought type
801     assert(function.getType() == funcType &&
802            "conflict between intrinsic wrapper types");
803   }
804   return function;
805 }
806 
807 /// Helpers to detect absent optional (not yet supported in outlining).
hasAbsentOptional(llvm::ArrayRef<mlir::Value> args)808 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
809   for (const auto &arg : args)
810     if (!arg)
811       return true;
812   return false;
813 }
hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args)814 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
815   for (const auto &arg : args)
816     if (!fir::getBase(arg))
817       return true;
818   return false;
819 }
820 
821 template <typename GeneratorType>
822 mlir::Value
outlineInWrapper(GeneratorType generator,llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)823 IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
824                                    llvm::StringRef name, mlir::Type resultType,
825                                    llvm::ArrayRef<mlir::Value> args) {
826   if (hasAbsentOptional(args)) {
827     // TODO: absent optional in outlining is an issue: we cannot just ignore
828     // them. Needs a better interface here. The issue is that we cannot easily
829     // tell that a value is optional or not here if it is presents. And if it is
830     // absent, we cannot tell what it type should be.
831     mlir::emitError(loc, "todo: cannot outline call to intrinsic " +
832                              llvm::Twine(name) +
833                              " with absent optional argument");
834     exit(1);
835   }
836 
837   auto funcType = getFunctionType(resultType, args, builder);
838   auto wrapper = getWrapper(generator, name, funcType);
839   return builder.create<mlir::CallOp>(loc, wrapper, args).getResult(0);
840 }
841 
842 fir::ExtendedValue
outlineInWrapper(ExtendedGenerator generator,llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args)843 IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator,
844                                    llvm::StringRef name, mlir::Type resultType,
845                                    llvm::ArrayRef<fir::ExtendedValue> args) {
846   if (hasAbsentOptional(args)) {
847     // TODO
848     mlir::emitError(loc, "todo: cannot outline call to intrinsic " +
849                              llvm::Twine(name) +
850                              " with absent optional argument");
851     exit(1);
852   }
853   llvm::SmallVector<mlir::Value, 2> mlirArgs;
854   for (const auto &extendedVal : args)
855     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
856   auto funcType = getFunctionType(resultType, mlirArgs, builder);
857   auto wrapper = getWrapper(generator, name, funcType);
858   auto mlirResult =
859       builder.create<mlir::CallOp>(loc, wrapper, mlirArgs).getResult(0);
860   return toExtendedValue(mlirResult, builder, loc);
861 }
862 
863 IntrinsicLibrary::RuntimeCallGenerator
getRuntimeCallGenerator(llvm::StringRef name,mlir::FunctionType soughtFuncType)864 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
865                                           mlir::FunctionType soughtFuncType) {
866   auto funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType);
867   if (!funcOp) {
868     mlir::emitError(loc,
869                     "TODO: missing intrinsic lowering: " + llvm::Twine(name));
870     llvm::errs() << "requested type was: " << soughtFuncType << "\n";
871     exit(1);
872   }
873 
874   mlir::FunctionType actualFuncType = funcOp.getType();
875   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
876          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
877          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
878 
879   return [funcOp, actualFuncType, soughtFuncType](
880              Fortran::lower::FirOpBuilder &builder, mlir::Location loc,
881              llvm::ArrayRef<mlir::Value> args) {
882     llvm::SmallVector<mlir::Value, 2> convertedArguments;
883     for (const auto &pair : llvm::zip(actualFuncType.getInputs(), args))
884       convertedArguments.push_back(
885           builder.createConvert(loc, std::get<0>(pair), std::get<1>(pair)));
886     auto call = builder.create<mlir::CallOp>(loc, funcOp, convertedArguments);
887     mlir::Type soughtType = soughtFuncType.getResult(0);
888     return builder.createConvert(loc, soughtType, call.getResult(0));
889   };
890 }
891 
getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,mlir::FunctionType signature)892 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
893     llvm::StringRef name, mlir::FunctionType signature) {
894   // Unrestricted intrinsics signature follows implicit rules: argument
895   // are passed by references. But the runtime versions expect values.
896   // So instead of duplicating the runtime, just have the wrappers loading
897   // this before calling the code generators.
898   bool loadRefArguments = true;
899   mlir::FuncOp funcOp;
900   for (auto &handler : handlers)
901     if (name == handler.name)
902       funcOp = std::visit(
903           [&](auto generator) {
904             return getWrapper(generator, name, signature, loadRefArguments);
905           },
906           handler.generator);
907 
908   if (!funcOp) {
909     llvm::SmallVector<mlir::Type, 2> argTypes;
910     for (auto type : signature.getInputs()) {
911       if (auto refType = type.dyn_cast<fir::ReferenceType>())
912         argTypes.push_back(refType.getEleTy());
913       else
914         argTypes.push_back(type);
915     }
916     auto soughtFuncType =
917         builder.getFunctionType(signature.getResults(), argTypes);
918     auto rtCallGenerator = getRuntimeCallGenerator(name, soughtFuncType);
919     funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
920   }
921 
922   return builder.getSymbolRefAttr(funcOp.getName());
923 }
924 
925 //===----------------------------------------------------------------------===//
926 // Code generators for the intrinsic
927 //===----------------------------------------------------------------------===//
928 
genRuntimeCall(llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)929 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
930                                              mlir::Type resultType,
931                                              llvm::ArrayRef<mlir::Value> args) {
932   mlir::FunctionType soughtFuncType =
933       getFunctionType(resultType, args, builder);
934   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
935 }
936 
genConversion(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)937 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
938                                             llvm::ArrayRef<mlir::Value> args) {
939   // There can be an optional kind in second argument.
940   assert(args.size() >= 1);
941   return builder.convertWithSemantics(loc, resultType, args[0]);
942 }
943 
944 // ABS
genAbs(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)945 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
946                                      llvm::ArrayRef<mlir::Value> args) {
947   assert(args.size() == 1);
948   auto arg = args[0];
949   auto type = arg.getType();
950   if (fir::isa_real(type)) {
951     // Runtime call to fp abs. An alternative would be to use mlir AbsFOp
952     // but it does not support all fir floating point types.
953     return genRuntimeCall("abs", resultType, args);
954   }
955   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
956     // At the time of this implementation there is no abs op in mlir.
957     // So, implement abs here without branching.
958     auto shift =
959         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
960     auto mask = builder.create<mlir::SignedShiftRightOp>(loc, arg, shift);
961     auto xored = builder.create<mlir::XOrOp>(loc, arg, mask);
962     return builder.create<mlir::SubIOp>(loc, xored, mask);
963   }
964   if (fir::isa_complex(type)) {
965     // Use HYPOT to fulfill the no underflow/overflow requirement.
966     auto parts =
967         Fortran::lower::ComplexExprHelper{builder, loc}.extractParts(arg);
968     llvm::SmallVector<mlir::Value, 2> args = {parts.first, parts.second};
969     return genRuntimeCall("hypot", resultType, args);
970   }
971   llvm_unreachable("unexpected type in ABS argument");
972 }
973 
974 // AIMAG
genAimag(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)975 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
976                                        llvm::ArrayRef<mlir::Value> args) {
977   assert(args.size() == 1);
978   return Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart(
979       args[0], true /* isImagPart */);
980 }
981 
982 // ANINT
genAnint(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)983 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
984                                        llvm::ArrayRef<mlir::Value> args) {
985   assert(args.size() >= 1);
986   // Skip optional kind argument to search the runtime; it is already reflected
987   // in result type.
988   return genRuntimeCall("anint", resultType, {args[0]});
989 }
990 
991 // AINT
genAint(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)992 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
993                                       llvm::ArrayRef<mlir::Value> args) {
994   assert(args.size() >= 1);
995   // Skip optional kind argument to search the runtime; it is already reflected
996   // in result type.
997   return genRuntimeCall("aint", resultType, {args[0]});
998 }
999 
1000 // CEILING
genCeiling(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1001 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
1002                                          llvm::ArrayRef<mlir::Value> args) {
1003   // Optional KIND argument.
1004   assert(args.size() >= 1);
1005   auto arg = args[0];
1006   // Use ceil that is not an actual Fortran intrinsic but that is
1007   // an llvm intrinsic that does the same, but return a floating
1008   // point.
1009   auto ceil = genRuntimeCall("ceil", arg.getType(), {arg});
1010   return builder.createConvert(loc, resultType, ceil);
1011 }
1012 
1013 // CONJG
genConjg(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1014 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
1015                                        llvm::ArrayRef<mlir::Value> args) {
1016   assert(args.size() == 1);
1017   if (resultType != args[0].getType())
1018     llvm_unreachable("argument type mismatch");
1019 
1020   mlir::Value cplx = args[0];
1021   auto imag =
1022       Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart(
1023           cplx, /*isImagPart=*/true);
1024   auto negImag = builder.create<fir::NegfOp>(loc, imag);
1025   return Fortran::lower::ComplexExprHelper{builder, loc}.insertComplexPart(
1026       cplx, negImag, /*isImagPart=*/true);
1027 }
1028 
1029 // DIM
genDim(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1030 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
1031                                      llvm::ArrayRef<mlir::Value> args) {
1032   assert(args.size() == 2);
1033   if (resultType.isa<mlir::IntegerType>()) {
1034     auto zero = builder.createIntegerConstant(loc, resultType, 0);
1035     auto diff = builder.create<mlir::SubIOp>(loc, args[0], args[1]);
1036     auto cmp =
1037         builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::sgt, diff, zero);
1038     return builder.create<mlir::SelectOp>(loc, cmp, diff, zero);
1039   }
1040   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
1041   auto zero = builder.createRealZeroConstant(loc, resultType);
1042   auto diff = builder.create<fir::SubfOp>(loc, args[0], args[1]);
1043   auto cmp =
1044       builder.create<fir::CmpfOp>(loc, mlir::CmpFPredicate::OGT, diff, zero);
1045   return builder.create<mlir::SelectOp>(loc, cmp, diff, zero);
1046 }
1047 
1048 // DPROD
genDprod(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1049 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
1050                                        llvm::ArrayRef<mlir::Value> args) {
1051   assert(args.size() == 2);
1052   assert(fir::isa_real(resultType) &&
1053          "Result must be double precision in DPROD");
1054   auto a = builder.createConvert(loc, resultType, args[0]);
1055   auto b = builder.createConvert(loc, resultType, args[1]);
1056   return builder.create<fir::MulfOp>(loc, a, b);
1057 }
1058 
1059 // FLOOR
genFloor(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1060 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
1061                                        llvm::ArrayRef<mlir::Value> args) {
1062   // Optional KIND argument.
1063   assert(args.size() >= 1);
1064   auto arg = args[0];
1065   // Use LLVM floor that returns real.
1066   auto floor = genRuntimeCall("floor", arg.getType(), {arg});
1067   return builder.createConvert(loc, resultType, floor);
1068 }
1069 
1070 // IAND
genIAnd(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1071 mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType,
1072                                       llvm::ArrayRef<mlir::Value> args) {
1073   assert(args.size() == 2);
1074 
1075   return builder.create<mlir::AndOp>(loc, args[0], args[1]);
1076 }
1077 
1078 // ICHAR
genIchar(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1079 mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType,
1080                                        llvm::ArrayRef<mlir::Value> args) {
1081   // There can be an optional kind in second argument.
1082   assert(args.size() >= 1);
1083 
1084   auto arg = args[0];
1085   Fortran::lower::CharacterExprHelper helper{builder, loc};
1086   auto dataAndLen = helper.createUnboxChar(arg);
1087   auto charType = fir::CharacterType::get(
1088       builder.getContext(), helper.getCharacterKind(arg.getType()));
1089   auto refType = builder.getRefType(charType);
1090   auto charAddr = builder.createConvert(loc, refType, dataAndLen.first);
1091   auto charVal = builder.create<fir::LoadOp>(loc, charType, charAddr);
1092   return builder.createConvert(loc, resultType, charVal);
1093 }
1094 
1095 // IEOR
genIEOr(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1096 mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType,
1097                                       llvm::ArrayRef<mlir::Value> args) {
1098   assert(args.size() == 2);
1099   return builder.create<mlir::XOrOp>(loc, args[0], args[1]);
1100 }
1101 
1102 // IOR
genIOr(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1103 mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType,
1104                                      llvm::ArrayRef<mlir::Value> args) {
1105   assert(args.size() == 2);
1106   return builder.create<mlir::OrOp>(loc, args[0], args[1]);
1107 }
1108 
1109 // LEN
1110 // Note that this is only used for unrestricted intrinsic.
1111 // Usage of LEN are otherwise rewritten as descriptor inquiries by the
1112 // front-end.
1113 fir::ExtendedValue
genLen(mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args)1114 IntrinsicLibrary::genLen(mlir::Type resultType,
1115                          llvm::ArrayRef<fir::ExtendedValue> args) {
1116   // Optional KIND argument reflected in result type.
1117   assert(args.size() >= 1);
1118   mlir::Value len;
1119   if (const auto *charBox = args[0].getCharBox()) {
1120     len = charBox->getLen();
1121   } else if (const auto *charBoxArray = args[0].getCharBox()) {
1122     len = charBoxArray->getLen();
1123   } else {
1124     Fortran::lower::CharacterExprHelper helper{builder, loc};
1125     len = helper.createUnboxChar(fir::getBase(args[0])).second;
1126   }
1127 
1128   return builder.createConvert(loc, resultType, len);
1129 }
1130 
1131 // LEN_TRIM
1132 fir::ExtendedValue
genLenTrim(mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args)1133 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
1134                              llvm::ArrayRef<fir::ExtendedValue> args) {
1135   // Optional KIND argument reflected in result type.
1136   assert(args.size() >= 1);
1137   Fortran::lower::CharacterExprHelper helper{builder, loc};
1138   auto len = helper.createLenTrim(fir::getBase(args[0]));
1139   return builder.createConvert(loc, resultType, len);
1140 }
1141 
1142 // MERGE
genMerge(mlir::Type,llvm::ArrayRef<mlir::Value> args)1143 mlir::Value IntrinsicLibrary::genMerge(mlir::Type,
1144                                        llvm::ArrayRef<mlir::Value> args) {
1145   assert(args.size() == 3);
1146 
1147   auto i1Type = mlir::IntegerType::get(1, builder.getContext());
1148   auto mask = builder.createConvert(loc, i1Type, args[2]);
1149   return builder.create<mlir::SelectOp>(loc, mask, args[0], args[1]);
1150 }
1151 
1152 // MOD
genMod(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1153 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
1154                                      llvm::ArrayRef<mlir::Value> args) {
1155   assert(args.size() == 2);
1156   if (resultType.isa<mlir::IntegerType>())
1157     return builder.create<mlir::SignedRemIOp>(loc, args[0], args[1]);
1158 
1159   // Use runtime. Note that mlir::RemFOp implements floating point
1160   // remainder, but it does not work with fir::Real type.
1161   // TODO: consider using mlir::RemFOp when possible, that may help folding
1162   // and  optimizations.
1163   return genRuntimeCall("mod", resultType, args);
1164 }
1165 
1166 // NINT
genNint(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1167 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
1168                                       llvm::ArrayRef<mlir::Value> args) {
1169   assert(args.size() >= 1);
1170   // Skip optional kind argument to search the runtime; it is already reflected
1171   // in result type.
1172   return genRuntimeCall("nint", resultType, {args[0]});
1173 }
1174 
1175 // SIGN
genSign(mlir::Type resultType,llvm::ArrayRef<mlir::Value> args)1176 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
1177                                       llvm::ArrayRef<mlir::Value> args) {
1178   assert(args.size() == 2);
1179   auto abs = genAbs(resultType, {args[0]});
1180   if (resultType.isa<mlir::IntegerType>()) {
1181     auto zero = builder.createIntegerConstant(loc, resultType, 0);
1182     auto neg = builder.create<mlir::SubIOp>(loc, zero, abs);
1183     auto cmp = builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::slt,
1184                                             args[1], zero);
1185     return builder.create<mlir::SelectOp>(loc, cmp, neg, abs);
1186   }
1187   // TODO: Requirements when second argument is +0./0.
1188   auto zeroAttr = builder.getZeroAttr(resultType);
1189   auto zero = builder.create<mlir::ConstantOp>(loc, resultType, zeroAttr);
1190   auto neg = builder.create<fir::NegfOp>(loc, abs);
1191   auto cmp =
1192       builder.create<fir::CmpfOp>(loc, mlir::CmpFPredicate::OLT, args[1], zero);
1193   return builder.create<mlir::SelectOp>(loc, cmp, neg, abs);
1194 }
1195 
1196 // Compare two FIR values and return boolean result as i1.
1197 template <Extremum extremum, ExtremumBehavior behavior>
createExtremumCompare(mlir::Location loc,Fortran::lower::FirOpBuilder & builder,mlir::Value left,mlir::Value right)1198 static mlir::Value createExtremumCompare(mlir::Location loc,
1199                                          Fortran::lower::FirOpBuilder &builder,
1200                                          mlir::Value left, mlir::Value right) {
1201   static constexpr auto integerPredicate = extremum == Extremum::Max
1202                                                ? mlir::CmpIPredicate::sgt
1203                                                : mlir::CmpIPredicate::slt;
1204   static constexpr auto orderedCmp = extremum == Extremum::Max
1205                                          ? mlir::CmpFPredicate::OGT
1206                                          : mlir::CmpFPredicate::OLT;
1207   auto type = left.getType();
1208   mlir::Value result;
1209   if (fir::isa_real(type)) {
1210     // Note: the signaling/quit aspect of the result required by IEEE
1211     // cannot currently be obtained with LLVM without ad-hoc runtime.
1212     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
1213       // Return the number if one of the inputs is NaN and the other is
1214       // a number.
1215       auto leftIsResult =
1216           builder.create<fir::CmpfOp>(loc, orderedCmp, left, right);
1217       auto rightIsNan = builder.create<fir::CmpfOp>(
1218           loc, mlir::CmpFPredicate::UNE, right, right);
1219       result = builder.create<mlir::OrOp>(loc, leftIsResult, rightIsNan);
1220     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
1221       // Always return NaNs if one the input is NaNs
1222       auto leftIsResult =
1223           builder.create<fir::CmpfOp>(loc, orderedCmp, left, right);
1224       auto leftIsNan = builder.create<fir::CmpfOp>(
1225           loc, mlir::CmpFPredicate::UNE, left, left);
1226       result = builder.create<mlir::OrOp>(loc, leftIsResult, leftIsNan);
1227     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
1228       // If the left is a NaN, return the right whatever it is.
1229       result = builder.create<fir::CmpfOp>(loc, orderedCmp, left, right);
1230     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
1231       // If one of the operand is a NaN, return left whatever it is.
1232       static constexpr auto unorderedCmp = extremum == Extremum::Max
1233                                                ? mlir::CmpFPredicate::UGT
1234                                                : mlir::CmpFPredicate::ULT;
1235       result = builder.create<fir::CmpfOp>(loc, unorderedCmp, left, right);
1236     } else {
1237       // TODO: ieeeMinNum/ieeeMaxNum
1238       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
1239                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
1240     }
1241   } else if (fir::isa_integer(type)) {
1242     result = builder.create<mlir::CmpIOp>(loc, integerPredicate, left, right);
1243   } else if (type.isa<fir::CharacterType>()) {
1244     // TODO: ! character min and max is tricky because the result
1245     // length is the length of the longest argument!
1246     // So we may need a temp.
1247   }
1248   assert(result);
1249   return result;
1250 }
1251 
1252 // MIN and MAX
1253 template <Extremum extremum, ExtremumBehavior behavior>
genExtremum(mlir::Type,llvm::ArrayRef<mlir::Value> args)1254 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
1255                                           llvm::ArrayRef<mlir::Value> args) {
1256   assert(args.size() >= 1);
1257   mlir::Value result = args[0];
1258   for (auto arg : args.drop_front()) {
1259     auto mask =
1260         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
1261     result = builder.create<mlir::SelectOp>(loc, mask, result, arg);
1262   }
1263   return result;
1264 }
1265 
1266 //===----------------------------------------------------------------------===//
1267 // Public intrinsic call helpers
1268 //===----------------------------------------------------------------------===//
1269 
1270 fir::ExtendedValue
genIntrinsicCall(Fortran::lower::FirOpBuilder & builder,mlir::Location loc,llvm::StringRef name,mlir::Type resultType,llvm::ArrayRef<fir::ExtendedValue> args)1271 Fortran::lower::genIntrinsicCall(Fortran::lower::FirOpBuilder &builder,
1272                                  mlir::Location loc, llvm::StringRef name,
1273                                  mlir::Type resultType,
1274                                  llvm::ArrayRef<fir::ExtendedValue> args) {
1275   return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType,
1276                                                          args);
1277 }
1278 
genMax(Fortran::lower::FirOpBuilder & builder,mlir::Location loc,llvm::ArrayRef<mlir::Value> args)1279 mlir::Value Fortran::lower::genMax(Fortran::lower::FirOpBuilder &builder,
1280                                    mlir::Location loc,
1281                                    llvm::ArrayRef<mlir::Value> args) {
1282   assert(args.size() > 0 && "max requires at least one argument");
1283   return IntrinsicLibrary{builder, loc}
1284       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
1285                                                               args);
1286 }
1287 
genMin(Fortran::lower::FirOpBuilder & builder,mlir::Location loc,llvm::ArrayRef<mlir::Value> args)1288 mlir::Value Fortran::lower::genMin(Fortran::lower::FirOpBuilder &builder,
1289                                    mlir::Location loc,
1290                                    llvm::ArrayRef<mlir::Value> args) {
1291   assert(args.size() > 0 && "min requires at least one argument");
1292   return IntrinsicLibrary{builder, loc}
1293       .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
1294                                                               args);
1295 }
1296 
genPow(Fortran::lower::FirOpBuilder & builder,mlir::Location loc,mlir::Type type,mlir::Value x,mlir::Value y)1297 mlir::Value Fortran::lower::genPow(Fortran::lower::FirOpBuilder &builder,
1298                                    mlir::Location loc, mlir::Type type,
1299                                    mlir::Value x, mlir::Value y) {
1300   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
1301 }
1302 
getUnrestrictedIntrinsicSymbolRefAttr(Fortran::lower::FirOpBuilder & builder,mlir::Location loc,llvm::StringRef name,mlir::FunctionType signature)1303 mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
1304     Fortran::lower::FirOpBuilder &builder, mlir::Location loc,
1305     llvm::StringRef name, mlir::FunctionType signature) {
1306   return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
1307       name, signature);
1308 }
1309