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