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