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