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