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