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