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