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