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