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