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