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