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/Optimizer/Builder/IntrinsicCall.h" 17 #include "flang/Common/static-multimap-view.h" 18 #include "flang/Optimizer/Builder/BoxValue.h" 19 #include "flang/Optimizer/Builder/Character.h" 20 #include "flang/Optimizer/Builder/Complex.h" 21 #include "flang/Optimizer/Builder/FIRBuilder.h" 22 #include "flang/Optimizer/Builder/MutableBox.h" 23 #include "flang/Optimizer/Builder/PPCIntrinsicCall.h" 24 #include "flang/Optimizer/Builder/Runtime/Allocatable.h" 25 #include "flang/Optimizer/Builder/Runtime/Character.h" 26 #include "flang/Optimizer/Builder/Runtime/Command.h" 27 #include "flang/Optimizer/Builder/Runtime/Derived.h" 28 #include "flang/Optimizer/Builder/Runtime/Exceptions.h" 29 #include "flang/Optimizer/Builder/Runtime/Execute.h" 30 #include "flang/Optimizer/Builder/Runtime/Inquiry.h" 31 #include "flang/Optimizer/Builder/Runtime/Intrinsics.h" 32 #include "flang/Optimizer/Builder/Runtime/Numeric.h" 33 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" 34 #include "flang/Optimizer/Builder/Runtime/Reduction.h" 35 #include "flang/Optimizer/Builder/Runtime/Stop.h" 36 #include "flang/Optimizer/Builder/Runtime/Transformational.h" 37 #include "flang/Optimizer/Builder/Todo.h" 38 #include "flang/Optimizer/Dialect/FIROps.h" 39 #include "flang/Optimizer/Dialect/FIROpsSupport.h" 40 #include "flang/Optimizer/Dialect/Support/FIRContext.h" 41 #include "flang/Optimizer/Support/FatalError.h" 42 #include "flang/Optimizer/Support/Utils.h" 43 #include "flang/Runtime/entry-names.h" 44 #include "flang/Runtime/iostat-consts.h" 45 #include "mlir/Dialect/Complex/IR/Complex.h" 46 #include "mlir/Dialect/LLVMIR/LLVMDialect.h" 47 #include "mlir/Dialect/LLVMIR/LLVMTypes.h" 48 #include "mlir/Dialect/Math/IR/Math.h" 49 #include "mlir/Dialect/Vector/IR/VectorOps.h" 50 #include "llvm/Support/CommandLine.h" 51 #include "llvm/Support/Debug.h" 52 #include "llvm/Support/MathExtras.h" 53 #include "llvm/Support/raw_ostream.h" 54 #include <cfenv> // temporary -- only used in genIeeeGetOrSetModesOrStatus 55 #include <optional> 56 57 #define DEBUG_TYPE "flang-lower-intrinsic" 58 59 /// This file implements lowering of Fortran intrinsic procedures and Fortran 60 /// intrinsic module procedures. A call may be inlined with a mix of FIR and 61 /// MLIR operations, or as a call to a runtime function or LLVM intrinsic. 62 63 /// Lowering of intrinsic procedure calls is based on a map that associates 64 /// Fortran intrinsic generic names to FIR generator functions. 65 /// All generator functions are member functions of the IntrinsicLibrary class 66 /// and have the same interface. 67 /// If no generator is given for an intrinsic name, a math runtime library 68 /// is searched for an implementation and, if a runtime function is found, 69 /// a call is generated for it. LLVM intrinsics are handled as a math 70 /// runtime library here. 71 72 namespace fir { 73 74 fir::ExtendedValue getAbsentIntrinsicArgument() { return fir::UnboxedValue{}; } 75 76 /// Test if an ExtendedValue is absent. This is used to test if an intrinsic 77 /// argument are absent at compile time. 78 static bool isStaticallyAbsent(const fir::ExtendedValue &exv) { 79 return !fir::getBase(exv); 80 } 81 static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args, 82 size_t argIndex) { 83 return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]); 84 } 85 static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args, 86 size_t argIndex) { 87 return args.size() <= argIndex || !args[argIndex]; 88 } 89 90 /// Test if an ExtendedValue is present. This is used to test if an intrinsic 91 /// argument is present at compile time. This does not imply that the related 92 /// value may not be an absent dummy optional, disassociated pointer, or a 93 /// deallocated allocatable. See `handleDynamicOptional` to deal with these 94 /// cases when it makes sense. 95 static bool isStaticallyPresent(const fir::ExtendedValue &exv) { 96 return !isStaticallyAbsent(exv); 97 } 98 99 using I = IntrinsicLibrary; 100 101 /// Flag to indicate that an intrinsic argument has to be handled as 102 /// being dynamically optional (e.g. special handling when actual 103 /// argument is an optional variable in the current scope). 104 static constexpr bool handleDynamicOptional = true; 105 106 /// Table that drives the fir generation depending on the intrinsic or intrinsic 107 /// module procedure one to one mapping with Fortran arguments. If no mapping is 108 /// defined here for a generic intrinsic, genRuntimeCall will be called 109 /// to look for a match in the runtime a emit a call. Note that the argument 110 /// lowering rules for an intrinsic need to be provided only if at least one 111 /// argument must not be lowered by value. In which case, the lowering rules 112 /// should be provided for all the intrinsic arguments for completeness. 113 static constexpr IntrinsicHandler handlers[]{ 114 {"abort", &I::genAbort}, 115 {"abs", &I::genAbs}, 116 {"achar", &I::genChar}, 117 {"acosd", &I::genAcosd}, 118 {"adjustl", 119 &I::genAdjustRtCall<fir::runtime::genAdjustL>, 120 {{{"string", asAddr}}}, 121 /*isElemental=*/true}, 122 {"adjustr", 123 &I::genAdjustRtCall<fir::runtime::genAdjustR>, 124 {{{"string", asAddr}}}, 125 /*isElemental=*/true}, 126 {"aimag", &I::genAimag}, 127 {"aint", &I::genAint}, 128 {"all", 129 &I::genAll, 130 {{{"mask", asAddr}, {"dim", asValue}}}, 131 /*isElemental=*/false}, 132 {"allocated", 133 &I::genAllocated, 134 {{{"array", asInquired}, {"scalar", asInquired}}}, 135 /*isElemental=*/false}, 136 {"anint", &I::genAnint}, 137 {"any", 138 &I::genAny, 139 {{{"mask", asAddr}, {"dim", asValue}}}, 140 /*isElemental=*/false}, 141 {"asind", &I::genAsind}, 142 {"associated", 143 &I::genAssociated, 144 {{{"pointer", asInquired}, {"target", asInquired}}}, 145 /*isElemental=*/false}, 146 {"atan2d", &I::genAtand}, 147 {"atan2pi", &I::genAtanpi}, 148 {"atand", &I::genAtand}, 149 {"atanpi", &I::genAtanpi}, 150 {"atomicaddd", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false}, 151 {"atomicaddf", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false}, 152 {"atomicaddi", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false}, 153 {"atomicaddl", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false}, 154 {"atomicandi", &I::genAtomicAnd, {{{"a", asAddr}, {"v", asValue}}}, false}, 155 {"atomicdeci", &I::genAtomicDec, {{{"a", asAddr}, {"v", asValue}}}, false}, 156 {"atomicinci", &I::genAtomicInc, {{{"a", asAddr}, {"v", asValue}}}, false}, 157 {"atomicmaxd", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false}, 158 {"atomicmaxf", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false}, 159 {"atomicmaxi", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false}, 160 {"atomicmaxl", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false}, 161 {"atomicmind", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false}, 162 {"atomicminf", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false}, 163 {"atomicmini", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false}, 164 {"atomicminl", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false}, 165 {"atomicori", &I::genAtomicOr, {{{"a", asAddr}, {"v", asValue}}}, false}, 166 {"atomicsubd", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false}, 167 {"atomicsubf", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false}, 168 {"atomicsubi", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false}, 169 {"atomicsubl", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false}, 170 {"bessel_jn", 171 &I::genBesselJn, 172 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}}, 173 /*isElemental=*/false}, 174 {"bessel_yn", 175 &I::genBesselYn, 176 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}}, 177 /*isElemental=*/false}, 178 {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>}, 179 {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>}, 180 {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>}, 181 {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>}, 182 {"btest", &I::genBtest}, 183 {"c_associated_c_funptr", 184 &I::genCAssociatedCFunPtr, 185 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}}, 186 /*isElemental=*/false}, 187 {"c_associated_c_ptr", 188 &I::genCAssociatedCPtr, 189 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}}, 190 /*isElemental=*/false}, 191 {"c_devloc", &I::genCDevLoc, {{{"x", asBox}}}, /*isElemental=*/false}, 192 {"c_f_pointer", 193 &I::genCFPointer, 194 {{{"cptr", asValue}, 195 {"fptr", asInquired}, 196 {"shape", asAddr, handleDynamicOptional}}}, 197 /*isElemental=*/false}, 198 {"c_f_procpointer", 199 &I::genCFProcPointer, 200 {{{"cptr", asValue}, {"fptr", asInquired}}}, 201 /*isElemental=*/false}, 202 {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false}, 203 {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false}, 204 {"c_ptr_eq", &I::genCPtrCompare<mlir::arith::CmpIPredicate::eq>}, 205 {"c_ptr_ne", &I::genCPtrCompare<mlir::arith::CmpIPredicate::ne>}, 206 {"ceiling", &I::genCeiling}, 207 {"char", &I::genChar}, 208 {"chdir", 209 &I::genChdir, 210 {{{"name", asAddr}, {"status", asAddr, handleDynamicOptional}}}, 211 /*isElemental=*/false}, 212 {"cmplx", 213 &I::genCmplx, 214 {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}}, 215 {"command_argument_count", &I::genCommandArgumentCount}, 216 {"conjg", &I::genConjg}, 217 {"cosd", &I::genCosd}, 218 {"count", 219 &I::genCount, 220 {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}}, 221 /*isElemental=*/false}, 222 {"cpu_time", 223 &I::genCpuTime, 224 {{{"time", asAddr}}}, 225 /*isElemental=*/false}, 226 {"cshift", 227 &I::genCshift, 228 {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}}, 229 /*isElemental=*/false}, 230 {"date_and_time", 231 &I::genDateAndTime, 232 {{{"date", asAddr, handleDynamicOptional}, 233 {"time", asAddr, handleDynamicOptional}, 234 {"zone", asAddr, handleDynamicOptional}, 235 {"values", asBox, handleDynamicOptional}}}, 236 /*isElemental=*/false}, 237 {"dble", &I::genConversion}, 238 {"dim", &I::genDim}, 239 {"dot_product", 240 &I::genDotProduct, 241 {{{"vector_a", asBox}, {"vector_b", asBox}}}, 242 /*isElemental=*/false}, 243 {"dprod", &I::genDprod}, 244 {"dshiftl", &I::genDshiftl}, 245 {"dshiftr", &I::genDshiftr}, 246 {"eoshift", 247 &I::genEoshift, 248 {{{"array", asBox}, 249 {"shift", asAddr}, 250 {"boundary", asBox, handleDynamicOptional}, 251 {"dim", asValue}}}, 252 /*isElemental=*/false}, 253 {"erfc_scaled", &I::genErfcScaled}, 254 {"etime", 255 &I::genEtime, 256 {{{"values", asBox}, {"time", asBox}}}, 257 /*isElemental=*/false}, 258 {"execute_command_line", 259 &I::genExecuteCommandLine, 260 {{{"command", asBox}, 261 {"wait", asAddr, handleDynamicOptional}, 262 {"exitstat", asBox, handleDynamicOptional}, 263 {"cmdstat", asBox, handleDynamicOptional}, 264 {"cmdmsg", asBox, handleDynamicOptional}}}, 265 /*isElemental=*/false}, 266 {"exit", 267 &I::genExit, 268 {{{"status", asValue, handleDynamicOptional}}}, 269 /*isElemental=*/false}, 270 {"exponent", &I::genExponent}, 271 {"extends_type_of", 272 &I::genExtendsTypeOf, 273 {{{"a", asBox}, {"mold", asBox}}}, 274 /*isElemental=*/false}, 275 {"findloc", 276 &I::genFindloc, 277 {{{"array", asBox}, 278 {"value", asAddr}, 279 {"dim", asValue}, 280 {"mask", asBox, handleDynamicOptional}, 281 {"kind", asValue}, 282 {"back", asValue, handleDynamicOptional}}}, 283 /*isElemental=*/false}, 284 {"floor", &I::genFloor}, 285 {"fraction", &I::genFraction}, 286 {"free", &I::genFree}, 287 {"get_command", 288 &I::genGetCommand, 289 {{{"command", asBox, handleDynamicOptional}, 290 {"length", asBox, handleDynamicOptional}, 291 {"status", asAddr, handleDynamicOptional}, 292 {"errmsg", asBox, handleDynamicOptional}}}, 293 /*isElemental=*/false}, 294 {"get_command_argument", 295 &I::genGetCommandArgument, 296 {{{"number", asValue}, 297 {"value", asBox, handleDynamicOptional}, 298 {"length", asBox, handleDynamicOptional}, 299 {"status", asAddr, handleDynamicOptional}, 300 {"errmsg", asBox, handleDynamicOptional}}}, 301 /*isElemental=*/false}, 302 {"get_environment_variable", 303 &I::genGetEnvironmentVariable, 304 {{{"name", asBox}, 305 {"value", asBox, handleDynamicOptional}, 306 {"length", asBox, handleDynamicOptional}, 307 {"status", asAddr, handleDynamicOptional}, 308 {"trim_name", asAddr, handleDynamicOptional}, 309 {"errmsg", asBox, handleDynamicOptional}}}, 310 /*isElemental=*/false}, 311 {"getcwd", 312 &I::genGetCwd, 313 {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}}, 314 /*isElemental=*/false}, 315 {"getgid", &I::genGetGID}, 316 {"getpid", &I::genGetPID}, 317 {"getuid", &I::genGetUID}, 318 {"iachar", &I::genIchar}, 319 {"iall", 320 &I::genIall, 321 {{{"array", asBox}, 322 {"dim", asValue}, 323 {"mask", asBox, handleDynamicOptional}}}, 324 /*isElemental=*/false}, 325 {"iand", &I::genIand}, 326 {"iany", 327 &I::genIany, 328 {{{"array", asBox}, 329 {"dim", asValue}, 330 {"mask", asBox, handleDynamicOptional}}}, 331 /*isElemental=*/false}, 332 {"ibclr", &I::genIbclr}, 333 {"ibits", &I::genIbits}, 334 {"ibset", &I::genIbset}, 335 {"ichar", &I::genIchar}, 336 {"ieee_class", &I::genIeeeClass}, 337 {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>}, 338 {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>}, 339 {"ieee_copy_sign", &I::genIeeeCopySign}, 340 {"ieee_get_flag", 341 &I::genIeeeGetFlag, 342 {{{"flag", asValue}, {"flag_value", asAddr}}}}, 343 {"ieee_get_halting_mode", 344 &I::genIeeeGetHaltingMode, 345 {{{"flag", asValue}, {"halting", asAddr}}}}, 346 {"ieee_get_modes", 347 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/true>}, 348 {"ieee_get_rounding_mode", 349 &I::genIeeeGetRoundingMode, 350 {{{"round_value", asAddr, handleDynamicOptional}, 351 {"radix", asValue, handleDynamicOptional}}}, 352 /*isElemental=*/false}, 353 {"ieee_get_status", 354 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/false>}, 355 {"ieee_get_underflow_mode", 356 &I::genIeeeGetUnderflowMode, 357 {{{"gradual", asAddr}}}, 358 /*isElemental=*/false}, 359 {"ieee_int", &I::genIeeeInt}, 360 {"ieee_is_finite", &I::genIeeeIsFinite}, 361 {"ieee_is_nan", &I::genIeeeIsNan}, 362 {"ieee_is_negative", &I::genIeeeIsNegative}, 363 {"ieee_is_normal", &I::genIeeeIsNormal}, 364 {"ieee_logb", &I::genIeeeLogb}, 365 {"ieee_max", 366 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/false>}, 367 {"ieee_max_mag", 368 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/true>}, 369 {"ieee_max_num", 370 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/false>}, 371 {"ieee_max_num_mag", 372 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/true>}, 373 {"ieee_min", 374 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/false>}, 375 {"ieee_min_mag", 376 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/true>}, 377 {"ieee_min_num", 378 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>}, 379 {"ieee_min_num_mag", 380 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>}, 381 {"ieee_next_after", &I::genNearest<I::NearestProc::NextAfter>}, 382 {"ieee_next_down", &I::genNearest<I::NearestProc::NextDown>}, 383 {"ieee_next_up", &I::genNearest<I::NearestProc::NextUp>}, 384 {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>}, 385 {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>}, 386 {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>}, 387 {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>}, 388 {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>}, 389 {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>}, 390 {"ieee_real", &I::genIeeeReal}, 391 {"ieee_rem", &I::genIeeeRem}, 392 {"ieee_rint", &I::genIeeeRint}, 393 {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>}, 394 {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>}, 395 {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>}, 396 {"ieee_set_halting_mode", 397 &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>}, 398 {"ieee_set_modes", 399 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/true>}, 400 {"ieee_set_rounding_mode", 401 &I::genIeeeSetRoundingMode, 402 {{{"round_value", asValue, handleDynamicOptional}, 403 {"radix", asValue, handleDynamicOptional}}}, 404 /*isElemental=*/false}, 405 {"ieee_set_status", 406 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/false>}, 407 {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode}, 408 {"ieee_signaling_eq", 409 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>}, 410 {"ieee_signaling_ge", 411 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGE>}, 412 {"ieee_signaling_gt", 413 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGT>}, 414 {"ieee_signaling_le", 415 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLE>}, 416 {"ieee_signaling_lt", 417 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLT>}, 418 {"ieee_signaling_ne", 419 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>}, 420 {"ieee_signbit", &I::genIeeeSignbit}, 421 {"ieee_support_flag", 422 &I::genIeeeSupportFlag, 423 {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}}, 424 /*isElemental=*/false}, 425 {"ieee_support_halting", &I::genIeeeSupportHalting}, 426 {"ieee_support_rounding", &I::genIeeeSupportRounding}, 427 {"ieee_unordered", &I::genIeeeUnordered}, 428 {"ieee_value", &I::genIeeeValue}, 429 {"ieor", &I::genIeor}, 430 {"index", 431 &I::genIndex, 432 {{{"string", asAddr}, 433 {"substring", asAddr}, 434 {"back", asValue, handleDynamicOptional}, 435 {"kind", asValue}}}}, 436 {"ior", &I::genIor}, 437 {"iparity", 438 &I::genIparity, 439 {{{"array", asBox}, 440 {"dim", asValue}, 441 {"mask", asBox, handleDynamicOptional}}}, 442 /*isElemental=*/false}, 443 {"is_contiguous", 444 &I::genIsContiguous, 445 {{{"array", asBox}}}, 446 /*isElemental=*/false}, 447 {"is_iostat_end", &I::genIsIostatValue<Fortran::runtime::io::IostatEnd>}, 448 {"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>}, 449 {"ishft", &I::genIshft}, 450 {"ishftc", &I::genIshftc}, 451 {"isnan", &I::genIeeeIsNan}, 452 {"lbound", 453 &I::genLbound, 454 {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}}, 455 /*isElemental=*/false}, 456 {"leadz", &I::genLeadz}, 457 {"len", 458 &I::genLen, 459 {{{"string", asInquired}, {"kind", asValue}}}, 460 /*isElemental=*/false}, 461 {"len_trim", &I::genLenTrim}, 462 {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>}, 463 {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>}, 464 {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>}, 465 {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>}, 466 {"lnblnk", &I::genLenTrim}, 467 {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false}, 468 {"malloc", &I::genMalloc}, 469 {"maskl", &I::genMask<mlir::arith::ShLIOp>}, 470 {"maskr", &I::genMask<mlir::arith::ShRUIOp>}, 471 {"matmul", 472 &I::genMatmul, 473 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}}, 474 /*isElemental=*/false}, 475 {"matmul_transpose", 476 &I::genMatmulTranspose, 477 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}}, 478 /*isElemental=*/false}, 479 {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>}, 480 {"maxloc", 481 &I::genMaxloc, 482 {{{"array", asBox}, 483 {"dim", asValue}, 484 {"mask", asBox, handleDynamicOptional}, 485 {"kind", asValue}, 486 {"back", asValue, handleDynamicOptional}}}, 487 /*isElemental=*/false}, 488 {"maxval", 489 &I::genMaxval, 490 {{{"array", asBox}, 491 {"dim", asValue}, 492 {"mask", asBox, handleDynamicOptional}}}, 493 /*isElemental=*/false}, 494 {"merge", &I::genMerge}, 495 {"merge_bits", &I::genMergeBits}, 496 {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>}, 497 {"minloc", 498 &I::genMinloc, 499 {{{"array", asBox}, 500 {"dim", asValue}, 501 {"mask", asBox, handleDynamicOptional}, 502 {"kind", asValue}, 503 {"back", asValue, handleDynamicOptional}}}, 504 /*isElemental=*/false}, 505 {"minval", 506 &I::genMinval, 507 {{{"array", asBox}, 508 {"dim", asValue}, 509 {"mask", asBox, handleDynamicOptional}}}, 510 /*isElemental=*/false}, 511 {"mod", &I::genMod}, 512 {"modulo", &I::genModulo}, 513 {"move_alloc", 514 &I::genMoveAlloc, 515 {{{"from", asInquired}, 516 {"to", asInquired}, 517 {"status", asAddr, handleDynamicOptional}, 518 {"errMsg", asBox, handleDynamicOptional}}}, 519 /*isElemental=*/false}, 520 {"mvbits", 521 &I::genMvbits, 522 {{{"from", asValue}, 523 {"frompos", asValue}, 524 {"len", asValue}, 525 {"to", asAddr}, 526 {"topos", asValue}}}}, 527 {"nearest", &I::genNearest<I::NearestProc::Nearest>}, 528 {"nint", &I::genNint}, 529 {"norm2", 530 &I::genNorm2, 531 {{{"array", asBox}, {"dim", asValue}}}, 532 /*isElemental=*/false}, 533 {"not", &I::genNot}, 534 {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false}, 535 {"pack", 536 &I::genPack, 537 {{{"array", asBox}, 538 {"mask", asBox}, 539 {"vector", asBox, handleDynamicOptional}}}, 540 /*isElemental=*/false}, 541 {"parity", 542 &I::genParity, 543 {{{"mask", asBox}, {"dim", asValue}}}, 544 /*isElemental=*/false}, 545 {"popcnt", &I::genPopcnt}, 546 {"poppar", &I::genPoppar}, 547 {"present", 548 &I::genPresent, 549 {{{"a", asInquired}}}, 550 /*isElemental=*/false}, 551 {"product", 552 &I::genProduct, 553 {{{"array", asBox}, 554 {"dim", asValue}, 555 {"mask", asBox, handleDynamicOptional}}}, 556 /*isElemental=*/false}, 557 {"random_init", 558 &I::genRandomInit, 559 {{{"repeatable", asValue}, {"image_distinct", asValue}}}, 560 /*isElemental=*/false}, 561 {"random_number", 562 &I::genRandomNumber, 563 {{{"harvest", asBox}}}, 564 /*isElemental=*/false}, 565 {"random_seed", 566 &I::genRandomSeed, 567 {{{"size", asBox, handleDynamicOptional}, 568 {"put", asBox, handleDynamicOptional}, 569 {"get", asBox, handleDynamicOptional}}}, 570 /*isElemental=*/false}, 571 {"reduce", 572 &I::genReduce, 573 {{{"array", asBox}, 574 {"operation", asAddr}, 575 {"dim", asValue}, 576 {"mask", asBox, handleDynamicOptional}, 577 {"identity", asAddr, handleDynamicOptional}, 578 {"ordered", asValue, handleDynamicOptional}}}, 579 /*isElemental=*/false}, 580 {"rename", 581 &I::genRename, 582 {{{"path1", asBox}, 583 {"path2", asBox}, 584 {"status", asBox, handleDynamicOptional}}}, 585 /*isElemental=*/false}, 586 {"repeat", 587 &I::genRepeat, 588 {{{"string", asAddr}, {"ncopies", asValue}}}, 589 /*isElemental=*/false}, 590 {"reshape", 591 &I::genReshape, 592 {{{"source", asBox}, 593 {"shape", asBox}, 594 {"pad", asBox, handleDynamicOptional}, 595 {"order", asBox, handleDynamicOptional}}}, 596 /*isElemental=*/false}, 597 {"rrspacing", &I::genRRSpacing}, 598 {"same_type_as", 599 &I::genSameTypeAs, 600 {{{"a", asBox}, {"b", asBox}}}, 601 /*isElemental=*/false}, 602 {"scale", 603 &I::genScale, 604 {{{"x", asValue}, {"i", asValue}}}, 605 /*isElemental=*/true}, 606 {"scan", 607 &I::genScan, 608 {{{"string", asAddr}, 609 {"set", asAddr}, 610 {"back", asValue, handleDynamicOptional}, 611 {"kind", asValue}}}, 612 /*isElemental=*/true}, 613 {"second", 614 &I::genSecond, 615 {{{"time", asAddr}}}, 616 /*isElemental=*/false}, 617 {"selected_char_kind", 618 &I::genSelectedCharKind, 619 {{{"name", asAddr}}}, 620 /*isElemental=*/false}, 621 {"selected_int_kind", 622 &I::genSelectedIntKind, 623 {{{"scalar", asAddr}}}, 624 /*isElemental=*/false}, 625 {"selected_logical_kind", 626 &I::genSelectedLogicalKind, 627 {{{"bits", asAddr}}}, 628 /*isElemental=*/false}, 629 {"selected_real_kind", 630 &I::genSelectedRealKind, 631 {{{"precision", asAddr, handleDynamicOptional}, 632 {"range", asAddr, handleDynamicOptional}, 633 {"radix", asAddr, handleDynamicOptional}}}, 634 /*isElemental=*/false}, 635 {"selected_unsigned_kind", 636 &I::genSelectedIntKind, // same results as selected_int_kind 637 {{{"scalar", asAddr}}}, 638 /*isElemental=*/false}, 639 {"set_exponent", &I::genSetExponent}, 640 {"shape", 641 &I::genShape, 642 {{{"source", asBox}, {"kind", asValue}}}, 643 /*isElemental=*/false}, 644 {"shifta", &I::genShiftA}, 645 {"shiftl", &I::genShift<mlir::arith::ShLIOp>}, 646 {"shiftr", &I::genShift<mlir::arith::ShRUIOp>}, 647 {"sign", &I::genSign}, 648 {"signal", 649 &I::genSignalSubroutine, 650 {{{"number", asValue}, {"handler", asAddr}, {"status", asAddr}}}, 651 /*isElemental=*/false}, 652 {"sind", &I::genSind}, 653 {"size", 654 &I::genSize, 655 {{{"array", asBox}, 656 {"dim", asAddr, handleDynamicOptional}, 657 {"kind", asValue}}}, 658 /*isElemental=*/false}, 659 {"sizeof", 660 &I::genSizeOf, 661 {{{"a", asBox}}}, 662 /*isElemental=*/false}, 663 {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false}, 664 {"spacing", &I::genSpacing}, 665 {"spread", 666 &I::genSpread, 667 {{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}}, 668 /*isElemental=*/false}, 669 {"storage_size", 670 &I::genStorageSize, 671 {{{"a", asInquired}, {"kind", asValue}}}, 672 /*isElemental=*/false}, 673 {"sum", 674 &I::genSum, 675 {{{"array", asBox}, 676 {"dim", asValue}, 677 {"mask", asBox, handleDynamicOptional}}}, 678 /*isElemental=*/false}, 679 {"syncthreads", &I::genSyncThreads, {}, /*isElemental=*/false}, 680 {"syncthreads_and", &I::genSyncThreadsAnd, {}, /*isElemental=*/false}, 681 {"syncthreads_count", &I::genSyncThreadsCount, {}, /*isElemental=*/false}, 682 {"syncthreads_or", &I::genSyncThreadsOr, {}, /*isElemental=*/false}, 683 {"system", 684 &I::genSystem, 685 {{{"command", asBox}, {"exitstat", asBox, handleDynamicOptional}}}, 686 /*isElemental=*/false}, 687 {"system_clock", 688 &I::genSystemClock, 689 {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}}, 690 /*isElemental=*/false}, 691 {"tand", &I::genTand}, 692 {"threadfence", &I::genThreadFence, {}, /*isElemental=*/false}, 693 {"threadfence_block", &I::genThreadFenceBlock, {}, /*isElemental=*/false}, 694 {"threadfence_system", &I::genThreadFenceSystem, {}, /*isElemental=*/false}, 695 {"trailz", &I::genTrailz}, 696 {"transfer", 697 &I::genTransfer, 698 {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}}, 699 /*isElemental=*/false}, 700 {"transpose", 701 &I::genTranspose, 702 {{{"matrix", asAddr}}}, 703 /*isElemental=*/false}, 704 {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false}, 705 {"ubound", 706 &I::genUbound, 707 {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}}, 708 /*isElemental=*/false}, 709 {"umaskl", &I::genMask<mlir::arith::ShLIOp>}, 710 {"umaskr", &I::genMask<mlir::arith::ShRUIOp>}, 711 {"unpack", 712 &I::genUnpack, 713 {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}}, 714 /*isElemental=*/false}, 715 {"verify", 716 &I::genVerify, 717 {{{"string", asAddr}, 718 {"set", asAddr}, 719 {"back", asValue, handleDynamicOptional}, 720 {"kind", asValue}}}, 721 /*isElemental=*/true}, 722 }; 723 724 template <std::size_t N> 725 static constexpr bool isSorted(const IntrinsicHandler (&array)[N]) { 726 // Replace by std::sorted when C++20 is default (will be constexpr). 727 const IntrinsicHandler *lastSeen{nullptr}; 728 bool isSorted{true}; 729 for (const auto &x : array) { 730 if (lastSeen) 731 isSorted &= std::string_view{lastSeen->name} < std::string_view{x.name}; 732 lastSeen = &x; 733 } 734 return isSorted; 735 } 736 static_assert(isSorted(handlers) && "map must be sorted"); 737 738 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) { 739 auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) { 740 return name.compare(handler.name) > 0; 741 }; 742 auto result = llvm::lower_bound(handlers, name, compare); 743 return result != std::end(handlers) && result->name == name ? result 744 : nullptr; 745 } 746 747 /// To make fir output more readable for debug, one can outline all intrinsic 748 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag). 749 static llvm::cl::opt<bool> outlineAllIntrinsics( 750 "outline-intrinsics", 751 llvm::cl::desc( 752 "Lower all intrinsic procedure implementation in their own functions"), 753 llvm::cl::init(false)); 754 755 //===----------------------------------------------------------------------===// 756 // Math runtime description and matching utility 757 //===----------------------------------------------------------------------===// 758 759 /// Command line option to modify math runtime behavior used to implement 760 /// intrinsics. This option applies both to early and late math-lowering modes. 761 enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion }; 762 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion( 763 "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"), 764 llvm::cl::values( 765 clEnumValN(fastVersion, "fast", "use fast runtime behavior"), 766 clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"), 767 clEnumValN(preciseVersion, "precise", "use precise runtime behavior")), 768 llvm::cl::init(fastVersion)); 769 770 static llvm::cl::opt<bool> 771 forceMlirComplex("force-mlir-complex", 772 llvm::cl::desc("Force using MLIR complex operations " 773 "instead of libm complex operations"), 774 llvm::cl::init(false)); 775 776 /// Return a string containing the given Fortran intrinsic name 777 /// with the type of its arguments specified in funcType 778 /// surrounded by the given prefix/suffix. 779 static std::string 780 prettyPrintIntrinsicName(fir::FirOpBuilder &builder, mlir::Location loc, 781 llvm::StringRef prefix, llvm::StringRef name, 782 llvm::StringRef suffix, mlir::FunctionType funcType) { 783 std::string output = prefix.str(); 784 llvm::raw_string_ostream sstream(output); 785 if (name == "pow") { 786 assert(funcType.getNumInputs() == 2 && "power operator has two arguments"); 787 std::string displayName{" ** "}; 788 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(0), loc, 789 displayName) 790 << displayName 791 << mlirTypeToIntrinsicFortran(builder, funcType.getInput(1), loc, 792 displayName); 793 } else { 794 sstream << name.upper() << "("; 795 if (funcType.getNumInputs() > 0) 796 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(0), loc, 797 name); 798 for (mlir::Type argType : funcType.getInputs().drop_front()) { 799 sstream << ", " 800 << mlirTypeToIntrinsicFortran(builder, argType, loc, name); 801 } 802 sstream << ")"; 803 } 804 sstream << suffix; 805 return output; 806 } 807 808 // Generate a call to the Fortran runtime library providing 809 // support for 128-bit float math. 810 // On 'HAS_LDBL128' targets the implementation 811 // is provided by FortranRuntime, otherwise, it is done via 812 // FortranFloat128Math library. In the latter case the compiler 813 // has to be built with FLANG_RUNTIME_F128_MATH_LIB to guarantee 814 // proper linking actions in the driver. 815 static mlir::Value genLibF128Call(fir::FirOpBuilder &builder, 816 mlir::Location loc, 817 const MathOperation &mathOp, 818 mlir::FunctionType libFuncType, 819 llvm::ArrayRef<mlir::Value> args) { 820 // TODO: if we knew that the C 'long double' does not have 113-bit mantissa 821 // on the target, we could have asserted that FLANG_RUNTIME_F128_MATH_LIB 822 // must be specified. For now just always generate the call even 823 // if it will be unresolved. 824 return genLibCall(builder, loc, mathOp, libFuncType, args); 825 } 826 827 mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc, 828 const MathOperation &mathOp, 829 mlir::FunctionType libFuncType, 830 llvm::ArrayRef<mlir::Value> args) { 831 llvm::StringRef libFuncName = mathOp.runtimeFunc; 832 833 // On AIX, __clog is used in libm. 834 if (fir::getTargetTriple(builder.getModule()).isOSAIX() && 835 libFuncName == "clog") { 836 libFuncName = "__clog"; 837 } 838 839 LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName 840 << "' call with type "; 841 libFuncType.dump(); llvm::dbgs() << "\n"); 842 mlir::func::FuncOp funcOp = builder.getNamedFunction(libFuncName); 843 844 if (!funcOp) { 845 funcOp = builder.createFunction(loc, libFuncName, libFuncType); 846 // C-interoperability rules apply to these library functions. 847 funcOp->setAttr(fir::getSymbolAttrName(), 848 mlir::StringAttr::get(builder.getContext(), libFuncName)); 849 // Set fir.runtime attribute to distinguish the function that 850 // was just created from user functions with the same name. 851 funcOp->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(), 852 builder.getUnitAttr()); 853 auto libCall = builder.create<fir::CallOp>(loc, funcOp, args); 854 // TODO: ensure 'strictfp' setting on the call for "precise/strict" 855 // FP mode. Set appropriate Fast-Math Flags otherwise. 856 // TODO: we should also mark as many libm function as possible 857 // with 'pure' attribute (of course, not in strict FP mode). 858 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n"); 859 return libCall.getResult(0); 860 } 861 862 // The function with the same name already exists. 863 fir::CallOp libCall; 864 mlir::Type soughtFuncType = funcOp.getFunctionType(); 865 866 if (soughtFuncType == libFuncType) { 867 libCall = builder.create<fir::CallOp>(loc, funcOp, args); 868 } else { 869 // A function with the same name might have been declared 870 // before (e.g. with an explicit interface and a binding label). 871 // It is in general incorrect to use the same definition for the library 872 // call, but we have no other options. Type cast the function to match 873 // the requested signature and generate an indirect call to avoid 874 // later failures caused by the signature mismatch. 875 LLVM_DEBUG(mlir::emitWarning( 876 loc, llvm::Twine("function signature mismatch for '") + 877 llvm::Twine(libFuncName) + 878 llvm::Twine("' may lead to undefined behavior."))); 879 mlir::SymbolRefAttr funcSymbolAttr = builder.getSymbolRefAttr(libFuncName); 880 mlir::Value funcPointer = 881 builder.create<fir::AddrOfOp>(loc, soughtFuncType, funcSymbolAttr); 882 funcPointer = builder.createConvert(loc, libFuncType, funcPointer); 883 884 llvm::SmallVector<mlir::Value, 3> operands{funcPointer}; 885 operands.append(args.begin(), args.end()); 886 libCall = builder.create<fir::CallOp>(loc, mlir::SymbolRefAttr{}, 887 libFuncType.getResults(), operands); 888 } 889 890 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n"); 891 return libCall.getResult(0); 892 } 893 894 mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder, 895 mlir::Location loc, 896 const MathOperation &mathOp, 897 mlir::FunctionType libFuncType, 898 llvm::ArrayRef<mlir::Value> args) { 899 assert(args.size() == 2 && "Incorrect #args to genLibSplitComplexArgsCall"); 900 901 auto getSplitComplexArgsType = [&builder, &args]() -> mlir::FunctionType { 902 mlir::Type ctype = args[0].getType(); 903 auto ftype = mlir::cast<mlir::ComplexType>(ctype).getElementType(); 904 return builder.getFunctionType({ftype, ftype, ftype, ftype}, {ctype}); 905 }; 906 907 llvm::SmallVector<mlir::Value, 4> splitArgs; 908 mlir::Value cplx1 = args[0]; 909 auto real1 = fir::factory::Complex{builder, loc}.extractComplexPart( 910 cplx1, /*isImagPart=*/false); 911 splitArgs.push_back(real1); 912 auto imag1 = fir::factory::Complex{builder, loc}.extractComplexPart( 913 cplx1, /*isImagPart=*/true); 914 splitArgs.push_back(imag1); 915 mlir::Value cplx2 = args[1]; 916 auto real2 = fir::factory::Complex{builder, loc}.extractComplexPart( 917 cplx2, /*isImagPart=*/false); 918 splitArgs.push_back(real2); 919 auto imag2 = fir::factory::Complex{builder, loc}.extractComplexPart( 920 cplx2, /*isImagPart=*/true); 921 splitArgs.push_back(imag2); 922 923 return genLibCall(builder, loc, mathOp, getSplitComplexArgsType(), splitArgs); 924 } 925 926 template <typename T> 927 mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc, 928 const MathOperation &mathOp, 929 mlir::FunctionType mathLibFuncType, 930 llvm::ArrayRef<mlir::Value> args) { 931 // TODO: we have to annotate the math operations with flags 932 // that will allow to define FP accuracy/exception 933 // behavior per operation, so that after early multi-module 934 // MLIR inlining we can distiguish operation that were 935 // compiled with different settings. 936 // Suggestion: 937 // * For "relaxed" FP mode set all Fast-Math Flags 938 // (see "[RFC] FastMath flags support in MLIR (arith dialect)" 939 // topic at discourse.llvm.org). 940 // * For "fast" FP mode set all Fast-Math Flags except 'afn'. 941 // * For "precise/strict" FP mode generate fir.calls to libm 942 // entries and annotate them with an attribute that will 943 // end up transformed into 'strictfp' LLVM attribute (TBD). 944 // Elsewhere, "precise/strict" FP mode should also set 945 // 'strictfp' for all user functions and calls so that 946 // LLVM backend does the right job. 947 // * Operations that cannot be reasonably optimized in MLIR 948 // can be also lowered to libm calls for "fast" and "relaxed" 949 // modes. 950 mlir::Value result; 951 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc; 952 if (mathRuntimeVersion == preciseVersion && 953 // Some operations do not have to be lowered as conservative 954 // calls, since they do not affect strict FP behavior. 955 // For example, purely integer operations like exponentiation 956 // with integer operands fall into this class. 957 !mathLibFuncName.empty()) { 958 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args); 959 } else { 960 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName 961 << "' operation with type "; 962 mathLibFuncType.dump(); llvm::dbgs() << "\n"); 963 result = builder.create<T>(loc, args); 964 } 965 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n"); 966 return result; 967 } 968 969 template <typename T> 970 mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc, 971 const MathOperation &mathOp, 972 mlir::FunctionType mathLibFuncType, 973 llvm::ArrayRef<mlir::Value> args) { 974 mlir::Value result; 975 bool canUseApprox = mlir::arith::bitEnumContainsAny( 976 builder.getFastMathFlags(), mlir::arith::FastMathFlags::afn); 977 978 // If we have libm functions, we can attempt to generate the more precise 979 // version of the complex math operation. 980 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc; 981 if (!mathLibFuncName.empty()) { 982 // If we enabled MLIR complex or can use approximate operations, we should 983 // NOT use libm. 984 if (!forceMlirComplex && !canUseApprox) { 985 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args); 986 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n"); 987 return result; 988 } 989 } 990 991 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName 992 << "' operation with type "; 993 mathLibFuncType.dump(); llvm::dbgs() << "\n"); 994 // Builder expects an extra return type to be provided if different to 995 // the argument types for an operation 996 if constexpr (T::template hasTrait< 997 mlir::OpTrait::SameOperandsAndResultType>()) { 998 result = builder.create<T>(loc, args); 999 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result); 1000 } else { 1001 auto complexTy = mlir::cast<mlir::ComplexType>(mathLibFuncType.getInput(0)); 1002 auto realTy = complexTy.getElementType(); 1003 result = builder.create<T>(loc, realTy, args); 1004 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result); 1005 } 1006 1007 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n"); 1008 return result; 1009 } 1010 1011 /// Mapping between mathematical intrinsic operations and MLIR operations 1012 /// of some appropriate dialect (math, complex, etc.) or libm calls. 1013 /// TODO: support remaining Fortran math intrinsics. 1014 /// See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\ 1015 /// Intrinsic-Procedures.html for a reference. 1016 constexpr auto FuncTypeReal16Real16 = genFuncType<Ty::Real<16>, Ty::Real<16>>; 1017 constexpr auto FuncTypeReal16Real16Real16 = 1018 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>; 1019 constexpr auto FuncTypeReal16Real16Real16Real16 = 1020 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>; 1021 constexpr auto FuncTypeReal16Integer4Real16 = 1022 genFuncType<Ty::Real<16>, Ty::Integer<4>, Ty::Real<16>>; 1023 constexpr auto FuncTypeInteger4Real16 = 1024 genFuncType<Ty::Integer<4>, Ty::Real<16>>; 1025 constexpr auto FuncTypeInteger8Real16 = 1026 genFuncType<Ty::Integer<8>, Ty::Real<16>>; 1027 constexpr auto FuncTypeReal16Complex16 = 1028 genFuncType<Ty::Real<16>, Ty::Complex<16>>; 1029 constexpr auto FuncTypeComplex16Complex16 = 1030 genFuncType<Ty::Complex<16>, Ty::Complex<16>>; 1031 constexpr auto FuncTypeComplex16Complex16Complex16 = 1032 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>; 1033 constexpr auto FuncTypeComplex16Complex16Integer4 = 1034 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<4>>; 1035 constexpr auto FuncTypeComplex16Complex16Integer8 = 1036 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<8>>; 1037 1038 static constexpr MathOperation mathOperations[] = { 1039 {"abs", "fabsf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1040 genMathOp<mlir::math::AbsFOp>}, 1041 {"abs", "fabs", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1042 genMathOp<mlir::math::AbsFOp>}, 1043 {"abs", "llvm.fabs.f128", genFuncType<Ty::Real<16>, Ty::Real<16>>, 1044 genMathOp<mlir::math::AbsFOp>}, 1045 {"abs", "cabsf", genFuncType<Ty::Real<4>, Ty::Complex<4>>, 1046 genComplexMathOp<mlir::complex::AbsOp>}, 1047 {"abs", "cabs", genFuncType<Ty::Real<8>, Ty::Complex<8>>, 1048 genComplexMathOp<mlir::complex::AbsOp>}, 1049 {"abs", RTNAME_STRING(CAbsF128), FuncTypeReal16Complex16, genLibF128Call}, 1050 {"acos", "acosf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1051 genMathOp<mlir::math::AcosOp>}, 1052 {"acos", "acos", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1053 genMathOp<mlir::math::AcosOp>}, 1054 {"acos", RTNAME_STRING(AcosF128), FuncTypeReal16Real16, genLibF128Call}, 1055 {"acos", "cacosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall}, 1056 {"acos", "cacos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall}, 1057 {"acos", RTNAME_STRING(CAcosF128), FuncTypeComplex16Complex16, 1058 genLibF128Call}, 1059 {"acosh", "acoshf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1060 {"acosh", "acosh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1061 {"acosh", RTNAME_STRING(AcoshF128), FuncTypeReal16Real16, genLibF128Call}, 1062 {"acosh", "cacoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1063 genLibCall}, 1064 {"acosh", "cacosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1065 genLibCall}, 1066 {"acosh", RTNAME_STRING(CAcoshF128), FuncTypeComplex16Complex16, 1067 genLibF128Call}, 1068 // llvm.trunc behaves the same way as libm's trunc. 1069 {"aint", "llvm.trunc.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1070 genLibCall}, 1071 {"aint", "llvm.trunc.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1072 genLibCall}, 1073 {"aint", "llvm.trunc.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>, 1074 genLibCall}, 1075 {"aint", RTNAME_STRING(TruncF128), FuncTypeReal16Real16, genLibF128Call}, 1076 // llvm.round behaves the same way as libm's round. 1077 {"anint", "llvm.round.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1078 genMathOp<mlir::LLVM::RoundOp>}, 1079 {"anint", "llvm.round.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1080 genMathOp<mlir::LLVM::RoundOp>}, 1081 {"anint", "llvm.round.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>, 1082 genMathOp<mlir::LLVM::RoundOp>}, 1083 {"anint", RTNAME_STRING(RoundF128), FuncTypeReal16Real16, genLibF128Call}, 1084 {"asin", "asinf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1085 {"asin", "asin", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1086 {"asin", RTNAME_STRING(AsinF128), FuncTypeReal16Real16, genLibF128Call}, 1087 {"asin", "casinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall}, 1088 {"asin", "casin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall}, 1089 {"asin", RTNAME_STRING(CAsinF128), FuncTypeComplex16Complex16, 1090 genLibF128Call}, 1091 {"asinh", "asinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1092 {"asinh", "asinh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1093 {"asinh", RTNAME_STRING(AsinhF128), FuncTypeReal16Real16, genLibF128Call}, 1094 {"asinh", "casinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1095 genLibCall}, 1096 {"asinh", "casinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1097 genLibCall}, 1098 {"asinh", RTNAME_STRING(CAsinhF128), FuncTypeComplex16Complex16, 1099 genLibF128Call}, 1100 {"atan", "atanf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1101 genMathOp<mlir::math::AtanOp>}, 1102 {"atan", "atan", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1103 genMathOp<mlir::math::AtanOp>}, 1104 {"atan", RTNAME_STRING(AtanF128), FuncTypeReal16Real16, genLibF128Call}, 1105 {"atan", "catanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall}, 1106 {"atan", "catan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall}, 1107 {"atan", RTNAME_STRING(CAtanF128), FuncTypeComplex16Complex16, 1108 genLibF128Call}, 1109 {"atan", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1110 genMathOp<mlir::math::Atan2Op>}, 1111 {"atan", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1112 genMathOp<mlir::math::Atan2Op>}, 1113 {"atan", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16, 1114 genLibF128Call}, 1115 {"atan2", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1116 genMathOp<mlir::math::Atan2Op>}, 1117 {"atan2", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1118 genMathOp<mlir::math::Atan2Op>}, 1119 {"atan2", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16, 1120 genLibF128Call}, 1121 {"atanh", "atanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1122 {"atanh", "atanh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1123 {"atanh", RTNAME_STRING(AtanhF128), FuncTypeReal16Real16, genLibF128Call}, 1124 {"atanh", "catanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1125 genLibCall}, 1126 {"atanh", "catanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1127 genLibCall}, 1128 {"atanh", RTNAME_STRING(CAtanhF128), FuncTypeComplex16Complex16, 1129 genLibF128Call}, 1130 {"bessel_j0", "j0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1131 {"bessel_j0", "j0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1132 {"bessel_j0", RTNAME_STRING(J0F128), FuncTypeReal16Real16, genLibF128Call}, 1133 {"bessel_j1", "j1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1134 {"bessel_j1", "j1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1135 {"bessel_j1", RTNAME_STRING(J1F128), FuncTypeReal16Real16, genLibF128Call}, 1136 {"bessel_jn", "jnf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>, 1137 genLibCall}, 1138 {"bessel_jn", "jn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>, 1139 genLibCall}, 1140 {"bessel_jn", RTNAME_STRING(JnF128), FuncTypeReal16Integer4Real16, 1141 genLibF128Call}, 1142 {"bessel_y0", "y0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1143 {"bessel_y0", "y0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1144 {"bessel_y0", RTNAME_STRING(Y0F128), FuncTypeReal16Real16, genLibF128Call}, 1145 {"bessel_y1", "y1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1146 {"bessel_y1", "y1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1147 {"bessel_y1", RTNAME_STRING(Y1F128), FuncTypeReal16Real16, genLibF128Call}, 1148 {"bessel_yn", "ynf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>, 1149 genLibCall}, 1150 {"bessel_yn", "yn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>, 1151 genLibCall}, 1152 {"bessel_yn", RTNAME_STRING(YnF128), FuncTypeReal16Integer4Real16, 1153 genLibF128Call}, 1154 // math::CeilOp returns a real, while Fortran CEILING returns integer. 1155 {"ceil", "ceilf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1156 genMathOp<mlir::math::CeilOp>}, 1157 {"ceil", "ceil", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1158 genMathOp<mlir::math::CeilOp>}, 1159 {"ceil", RTNAME_STRING(CeilF128), FuncTypeReal16Real16, genLibF128Call}, 1160 {"cos", "cosf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1161 genMathOp<mlir::math::CosOp>}, 1162 {"cos", "cos", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1163 genMathOp<mlir::math::CosOp>}, 1164 {"cos", RTNAME_STRING(CosF128), FuncTypeReal16Real16, genLibF128Call}, 1165 {"cos", "ccosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1166 genComplexMathOp<mlir::complex::CosOp>}, 1167 {"cos", "ccos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1168 genComplexMathOp<mlir::complex::CosOp>}, 1169 {"cos", RTNAME_STRING(CCosF128), FuncTypeComplex16Complex16, 1170 genLibF128Call}, 1171 {"cosh", "coshf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1172 genMathOp<mlir::math::CoshOp>}, 1173 {"cosh", "cosh", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1174 genMathOp<mlir::math::CoshOp>}, 1175 {"cosh", RTNAME_STRING(CoshF128), FuncTypeReal16Real16, genLibF128Call}, 1176 {"cosh", "ccoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall}, 1177 {"cosh", "ccosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall}, 1178 {"cosh", RTNAME_STRING(CCoshF128), FuncTypeComplex16Complex16, 1179 genLibF128Call}, 1180 {"divc", 1181 {}, 1182 genFuncType<Ty::Complex<2>, Ty::Complex<2>, Ty::Complex<2>>, 1183 genComplexMathOp<mlir::complex::DivOp>}, 1184 {"divc", 1185 {}, 1186 genFuncType<Ty::Complex<3>, Ty::Complex<3>, Ty::Complex<3>>, 1187 genComplexMathOp<mlir::complex::DivOp>}, 1188 {"divc", "__divsc3", 1189 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>, 1190 genLibSplitComplexArgsCall}, 1191 {"divc", "__divdc3", 1192 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>, 1193 genLibSplitComplexArgsCall}, 1194 {"divc", "__divxc3", 1195 genFuncType<Ty::Complex<10>, Ty::Complex<10>, Ty::Complex<10>>, 1196 genLibSplitComplexArgsCall}, 1197 {"divc", "__divtc3", 1198 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>, 1199 genLibSplitComplexArgsCall}, 1200 {"erf", "erff", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1201 genMathOp<mlir::math::ErfOp>}, 1202 {"erf", "erf", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1203 genMathOp<mlir::math::ErfOp>}, 1204 {"erf", RTNAME_STRING(ErfF128), FuncTypeReal16Real16, genLibF128Call}, 1205 {"erfc", "erfcf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1206 {"erfc", "erfc", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1207 {"erfc", RTNAME_STRING(ErfcF128), FuncTypeReal16Real16, genLibF128Call}, 1208 {"exp", "expf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1209 genMathOp<mlir::math::ExpOp>}, 1210 {"exp", "exp", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1211 genMathOp<mlir::math::ExpOp>}, 1212 {"exp", RTNAME_STRING(ExpF128), FuncTypeReal16Real16, genLibF128Call}, 1213 {"exp", "cexpf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1214 genComplexMathOp<mlir::complex::ExpOp>}, 1215 {"exp", "cexp", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1216 genComplexMathOp<mlir::complex::ExpOp>}, 1217 {"exp", RTNAME_STRING(CExpF128), FuncTypeComplex16Complex16, 1218 genLibF128Call}, 1219 {"feclearexcept", "feclearexcept", 1220 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall}, 1221 {"fedisableexcept", "fedisableexcept", 1222 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall}, 1223 {"feenableexcept", "feenableexcept", 1224 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall}, 1225 {"fegetenv", "fegetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>, 1226 genLibCall}, 1227 {"fegetexcept", "fegetexcept", genFuncType<Ty::Integer<4>>, genLibCall}, 1228 {"fegetmode", "fegetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>, 1229 genLibCall}, 1230 {"feraiseexcept", "feraiseexcept", 1231 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall}, 1232 {"fesetenv", "fesetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>, 1233 genLibCall}, 1234 {"fesetmode", "fesetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>, 1235 genLibCall}, 1236 {"fetestexcept", "fetestexcept", 1237 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall}, 1238 {"feupdateenv", "feupdateenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>, 1239 genLibCall}, 1240 // math::FloorOp returns a real, while Fortran FLOOR returns integer. 1241 {"floor", "floorf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1242 genMathOp<mlir::math::FloorOp>}, 1243 {"floor", "floor", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1244 genMathOp<mlir::math::FloorOp>}, 1245 {"floor", RTNAME_STRING(FloorF128), FuncTypeReal16Real16, genLibF128Call}, 1246 {"fma", "llvm.fma.f32", 1247 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1248 genMathOp<mlir::math::FmaOp>}, 1249 {"fma", "llvm.fma.f64", 1250 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1251 genMathOp<mlir::math::FmaOp>}, 1252 {"fma", RTNAME_STRING(FmaF128), FuncTypeReal16Real16Real16Real16, 1253 genLibF128Call}, 1254 {"gamma", "tgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1255 {"gamma", "tgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1256 {"gamma", RTNAME_STRING(TgammaF128), FuncTypeReal16Real16, genLibF128Call}, 1257 {"hypot", "hypotf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1258 genLibCall}, 1259 {"hypot", "hypot", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1260 genLibCall}, 1261 {"hypot", RTNAME_STRING(HypotF128), FuncTypeReal16Real16Real16, 1262 genLibF128Call}, 1263 {"log", "logf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1264 genMathOp<mlir::math::LogOp>}, 1265 {"log", "log", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1266 genMathOp<mlir::math::LogOp>}, 1267 {"log", RTNAME_STRING(LogF128), FuncTypeReal16Real16, genLibF128Call}, 1268 {"log", "clogf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1269 genComplexMathOp<mlir::complex::LogOp>}, 1270 {"log", "clog", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1271 genComplexMathOp<mlir::complex::LogOp>}, 1272 {"log", RTNAME_STRING(CLogF128), FuncTypeComplex16Complex16, 1273 genLibF128Call}, 1274 {"log10", "log10f", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1275 genMathOp<mlir::math::Log10Op>}, 1276 {"log10", "log10", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1277 genMathOp<mlir::math::Log10Op>}, 1278 {"log10", RTNAME_STRING(Log10F128), FuncTypeReal16Real16, genLibF128Call}, 1279 {"log_gamma", "lgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1280 {"log_gamma", "lgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1281 {"log_gamma", RTNAME_STRING(LgammaF128), FuncTypeReal16Real16, 1282 genLibF128Call}, 1283 {"nearbyint", "llvm.nearbyint.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1284 genLibCall}, 1285 {"nearbyint", "llvm.nearbyint.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1286 genLibCall}, 1287 {"nearbyint", "llvm.nearbyint.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>, 1288 genLibCall}, 1289 {"nearbyint", RTNAME_STRING(NearbyintF128), FuncTypeReal16Real16, 1290 genLibF128Call}, 1291 // llvm.lround behaves the same way as libm's lround. 1292 {"nint", "llvm.lround.i64.f64", genFuncType<Ty::Integer<8>, Ty::Real<8>>, 1293 genLibCall}, 1294 {"nint", "llvm.lround.i64.f32", genFuncType<Ty::Integer<8>, Ty::Real<4>>, 1295 genLibCall}, 1296 {"nint", RTNAME_STRING(LlroundF128), FuncTypeInteger8Real16, 1297 genLibF128Call}, 1298 {"nint", "llvm.lround.i32.f64", genFuncType<Ty::Integer<4>, Ty::Real<8>>, 1299 genLibCall}, 1300 {"nint", "llvm.lround.i32.f32", genFuncType<Ty::Integer<4>, Ty::Real<4>>, 1301 genLibCall}, 1302 {"nint", RTNAME_STRING(LroundF128), FuncTypeInteger4Real16, genLibF128Call}, 1303 {"pow", 1304 {}, 1305 genFuncType<Ty::Integer<1>, Ty::Integer<1>, Ty::Integer<1>>, 1306 genMathOp<mlir::math::IPowIOp>}, 1307 {"pow", 1308 {}, 1309 genFuncType<Ty::Integer<2>, Ty::Integer<2>, Ty::Integer<2>>, 1310 genMathOp<mlir::math::IPowIOp>}, 1311 {"pow", 1312 {}, 1313 genFuncType<Ty::Integer<4>, Ty::Integer<4>, Ty::Integer<4>>, 1314 genMathOp<mlir::math::IPowIOp>}, 1315 {"pow", 1316 {}, 1317 genFuncType<Ty::Integer<8>, Ty::Integer<8>, Ty::Integer<8>>, 1318 genMathOp<mlir::math::IPowIOp>}, 1319 {"pow", "powf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1320 genMathOp<mlir::math::PowFOp>}, 1321 {"pow", "pow", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1322 genMathOp<mlir::math::PowFOp>}, 1323 {"pow", RTNAME_STRING(PowF128), FuncTypeReal16Real16Real16, genLibF128Call}, 1324 {"pow", "cpowf", 1325 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>, 1326 genComplexMathOp<mlir::complex::PowOp>}, 1327 {"pow", "cpow", genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>, 1328 genComplexMathOp<mlir::complex::PowOp>}, 1329 {"pow", RTNAME_STRING(CPowF128), FuncTypeComplex16Complex16Complex16, 1330 genLibF128Call}, 1331 {"pow", RTNAME_STRING(FPow4i), 1332 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<4>>, 1333 genMathOp<mlir::math::FPowIOp>}, 1334 {"pow", RTNAME_STRING(FPow8i), 1335 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<4>>, 1336 genMathOp<mlir::math::FPowIOp>}, 1337 {"pow", RTNAME_STRING(FPow16i), 1338 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<4>>, 1339 genMathOp<mlir::math::FPowIOp>}, 1340 {"pow", RTNAME_STRING(FPow4k), 1341 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<8>>, 1342 genMathOp<mlir::math::FPowIOp>}, 1343 {"pow", RTNAME_STRING(FPow8k), 1344 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<8>>, 1345 genMathOp<mlir::math::FPowIOp>}, 1346 {"pow", RTNAME_STRING(FPow16k), 1347 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<8>>, 1348 genMathOp<mlir::math::FPowIOp>}, 1349 {"pow", RTNAME_STRING(cpowi), 1350 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<4>>, genLibCall}, 1351 {"pow", RTNAME_STRING(zpowi), 1352 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<4>>, genLibCall}, 1353 {"pow", RTNAME_STRING(cqpowi), FuncTypeComplex16Complex16Integer4, 1354 genLibF128Call}, 1355 {"pow", RTNAME_STRING(cpowk), 1356 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<8>>, genLibCall}, 1357 {"pow", RTNAME_STRING(zpowk), 1358 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<8>>, genLibCall}, 1359 {"pow", RTNAME_STRING(cqpowk), FuncTypeComplex16Complex16Integer8, 1360 genLibF128Call}, 1361 {"remainder", "remainderf", 1362 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1363 {"remainder", "remainder", 1364 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1365 {"remainder", "remainderl", 1366 genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>, genLibCall}, 1367 {"remainder", RTNAME_STRING(RemainderF128), FuncTypeReal16Real16Real16, 1368 genLibF128Call}, 1369 {"sign", "copysignf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, 1370 genMathOp<mlir::math::CopySignOp>}, 1371 {"sign", "copysign", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, 1372 genMathOp<mlir::math::CopySignOp>}, 1373 {"sign", "copysignl", genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>, 1374 genMathOp<mlir::math::CopySignOp>}, 1375 {"sign", "llvm.copysign.f128", 1376 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>, 1377 genMathOp<mlir::math::CopySignOp>}, 1378 {"sin", "sinf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1379 genMathOp<mlir::math::SinOp>}, 1380 {"sin", "sin", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1381 genMathOp<mlir::math::SinOp>}, 1382 {"sin", RTNAME_STRING(SinF128), FuncTypeReal16Real16, genLibF128Call}, 1383 {"sin", "csinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1384 genComplexMathOp<mlir::complex::SinOp>}, 1385 {"sin", "csin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1386 genComplexMathOp<mlir::complex::SinOp>}, 1387 {"sin", RTNAME_STRING(CSinF128), FuncTypeComplex16Complex16, 1388 genLibF128Call}, 1389 {"sinh", "sinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall}, 1390 {"sinh", "sinh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall}, 1391 {"sinh", RTNAME_STRING(SinhF128), FuncTypeReal16Real16, genLibF128Call}, 1392 {"sinh", "csinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall}, 1393 {"sinh", "csinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall}, 1394 {"sinh", RTNAME_STRING(CSinhF128), FuncTypeComplex16Complex16, 1395 genLibF128Call}, 1396 {"sqrt", "sqrtf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1397 genMathOp<mlir::math::SqrtOp>}, 1398 {"sqrt", "sqrt", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1399 genMathOp<mlir::math::SqrtOp>}, 1400 {"sqrt", RTNAME_STRING(SqrtF128), FuncTypeReal16Real16, genLibF128Call}, 1401 {"sqrt", "csqrtf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1402 genComplexMathOp<mlir::complex::SqrtOp>}, 1403 {"sqrt", "csqrt", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1404 genComplexMathOp<mlir::complex::SqrtOp>}, 1405 {"sqrt", RTNAME_STRING(CSqrtF128), FuncTypeComplex16Complex16, 1406 genLibF128Call}, 1407 {"tan", "tanf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1408 genMathOp<mlir::math::TanOp>}, 1409 {"tan", "tan", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1410 genMathOp<mlir::math::TanOp>}, 1411 {"tan", RTNAME_STRING(TanF128), FuncTypeReal16Real16, genLibF128Call}, 1412 {"tan", "ctanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1413 genComplexMathOp<mlir::complex::TanOp>}, 1414 {"tan", "ctan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1415 genComplexMathOp<mlir::complex::TanOp>}, 1416 {"tan", RTNAME_STRING(CTanF128), FuncTypeComplex16Complex16, 1417 genLibF128Call}, 1418 {"tanh", "tanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, 1419 genMathOp<mlir::math::TanhOp>}, 1420 {"tanh", "tanh", genFuncType<Ty::Real<8>, Ty::Real<8>>, 1421 genMathOp<mlir::math::TanhOp>}, 1422 {"tanh", RTNAME_STRING(TanhF128), FuncTypeReal16Real16, genLibF128Call}, 1423 {"tanh", "ctanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, 1424 genComplexMathOp<mlir::complex::TanhOp>}, 1425 {"tanh", "ctanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, 1426 genComplexMathOp<mlir::complex::TanhOp>}, 1427 {"tanh", RTNAME_STRING(CTanhF128), FuncTypeComplex16Complex16, 1428 genLibF128Call}, 1429 }; 1430 1431 // This helper class computes a "distance" between two function types. 1432 // The distance measures how many narrowing conversions of actual arguments 1433 // and result of "from" must be made in order to use "to" instead of "from". 1434 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is 1435 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means 1436 // if no implementation of ACOS(REAL(10)) is available, it is better to use 1437 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)). 1438 // Note that this is not a symmetric distance and the order of "from" and "to" 1439 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it 1440 // may be safe to replace foo by bar, but not the opposite. 1441 class FunctionDistance { 1442 public: 1443 FunctionDistance() : infinite{true} {} 1444 1445 FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) { 1446 unsigned nInputs = from.getNumInputs(); 1447 unsigned nResults = from.getNumResults(); 1448 if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) { 1449 infinite = true; 1450 } else { 1451 for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i) 1452 addArgumentDistance(from.getInput(i), to.getInput(i)); 1453 for (decltype(nResults) i = 0; i < nResults && !infinite; ++i) 1454 addResultDistance(to.getResult(i), from.getResult(i)); 1455 } 1456 } 1457 1458 /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be 1459 /// false if both d1 and d2 are infinite. This implies that 1460 /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1) 1461 bool isSmallerThan(const FunctionDistance &d) const { 1462 return !infinite && 1463 (d.infinite || std::lexicographical_compare( 1464 conversions.begin(), conversions.end(), 1465 d.conversions.begin(), d.conversions.end())); 1466 } 1467 1468 bool isLosingPrecision() const { 1469 return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; 1470 } 1471 1472 bool isInfinite() const { return infinite; } 1473 1474 private: 1475 enum class Conversion { Forbidden, None, Narrow, Extend }; 1476 1477 void addArgumentDistance(mlir::Type from, mlir::Type to) { 1478 switch (conversionBetweenTypes(from, to)) { 1479 case Conversion::Forbidden: 1480 infinite = true; 1481 break; 1482 case Conversion::None: 1483 break; 1484 case Conversion::Narrow: 1485 conversions[narrowingArg]++; 1486 break; 1487 case Conversion::Extend: 1488 conversions[nonNarrowingArg]++; 1489 break; 1490 } 1491 } 1492 1493 void addResultDistance(mlir::Type from, mlir::Type to) { 1494 switch (conversionBetweenTypes(from, to)) { 1495 case Conversion::Forbidden: 1496 infinite = true; 1497 break; 1498 case Conversion::None: 1499 break; 1500 case Conversion::Narrow: 1501 conversions[nonExtendingResult]++; 1502 break; 1503 case Conversion::Extend: 1504 conversions[extendingResult]++; 1505 break; 1506 } 1507 } 1508 1509 // Floating point can be mlir Float or Complex Type. 1510 static unsigned getFloatingPointWidth(mlir::Type t) { 1511 if (auto f{mlir::dyn_cast<mlir::FloatType>(t)}) 1512 return f.getWidth(); 1513 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(t)}) 1514 return mlir::cast<mlir::FloatType>(cplx.getElementType()).getWidth(); 1515 llvm_unreachable("not a floating-point type"); 1516 } 1517 1518 static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) { 1519 if (from == to) 1520 return Conversion::None; 1521 1522 if (auto fromIntTy{mlir::dyn_cast<mlir::IntegerType>(from)}) { 1523 if (auto toIntTy{mlir::dyn_cast<mlir::IntegerType>(to)}) { 1524 return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow 1525 : Conversion::Extend; 1526 } 1527 } 1528 1529 if (fir::isa_real(from) && fir::isa_real(to)) { 1530 return getFloatingPointWidth(from) > getFloatingPointWidth(to) 1531 ? Conversion::Narrow 1532 : Conversion::Extend; 1533 } 1534 1535 if (fir::isa_complex(from) && fir::isa_complex(to)) { 1536 return getFloatingPointWidth(from) > getFloatingPointWidth(to) 1537 ? Conversion::Narrow 1538 : Conversion::Extend; 1539 } 1540 // Notes: 1541 // - No conversion between character types, specialization of runtime 1542 // functions should be made instead. 1543 // - It is not clear there is a use case for automatic conversions 1544 // around Logical and it may damage hidden information in the physical 1545 // storage so do not do it. 1546 return Conversion::Forbidden; 1547 } 1548 1549 // Below are indexes to access data in conversions. 1550 // The order in data does matter for lexicographical_compare 1551 enum { 1552 narrowingArg = 0, // usually bad 1553 extendingResult, // usually bad 1554 nonExtendingResult, // usually ok 1555 nonNarrowingArg, // usually ok 1556 dataSize 1557 }; 1558 1559 std::array<int, dataSize> conversions = {}; 1560 bool infinite = false; // When forbidden conversion or wrong argument number 1561 }; 1562 1563 using RtMap = Fortran::common::StaticMultimapView<MathOperation>; 1564 static constexpr RtMap mathOps(mathOperations); 1565 static_assert(mathOps.Verify() && "map must be sorted"); 1566 1567 /// Look for a MathOperation entry specifying how to lower a mathematical 1568 /// operation defined by \p name with its result' and operands' types 1569 /// specified in the form of a FunctionType \p funcType. 1570 /// If exact match for the given types is found, then the function 1571 /// returns a pointer to the corresponding MathOperation. 1572 /// Otherwise, the function returns nullptr. 1573 /// If there is a MathOperation that can be used with additional 1574 /// type casts for the operands or/and result (non-exact match), 1575 /// then it is returned via \p bestNearMatch argument, and 1576 /// \p bestMatchDistance specifies the FunctionDistance between 1577 /// the requested operation and the non-exact match. 1578 static const MathOperation * 1579 searchMathOperation(fir::FirOpBuilder &builder, 1580 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range, 1581 mlir::FunctionType funcType, 1582 const MathOperation **bestNearMatch, 1583 FunctionDistance &bestMatchDistance) { 1584 for (auto iter = range.first; iter != range.second && iter; ++iter) { 1585 const auto &impl = *iter; 1586 auto implType = impl.typeGenerator(builder.getContext(), builder); 1587 if (funcType == implType) { 1588 return &impl; // exact match 1589 } 1590 1591 FunctionDistance distance(funcType, implType); 1592 if (distance.isSmallerThan(bestMatchDistance)) { 1593 *bestNearMatch = &impl; 1594 bestMatchDistance = std::move(distance); 1595 } 1596 } 1597 return nullptr; 1598 } 1599 1600 /// Implementation of the operation defined by \p name with type 1601 /// \p funcType is not precise, and the actual available implementation 1602 /// is \p distance away from the requested. If using the available 1603 /// implementation results in a precision loss, emit an error message 1604 /// with the given code location \p loc. 1605 static void checkPrecisionLoss(llvm::StringRef name, 1606 mlir::FunctionType funcType, 1607 const FunctionDistance &distance, 1608 fir::FirOpBuilder &builder, mlir::Location loc) { 1609 if (!distance.isLosingPrecision()) 1610 return; 1611 1612 // Using this runtime version requires narrowing the arguments 1613 // or extending the result. It is not numerically safe. There 1614 // is currently no quad math library that was described in 1615 // lowering and could be used here. Emit an error and continue 1616 // generating the code with the narrowing cast so that the user 1617 // can get a complete list of the problematic intrinsic calls. 1618 std::string message = prettyPrintIntrinsicName( 1619 builder, loc, "not yet implemented: no math runtime available for '", 1620 name, "'", funcType); 1621 mlir::emitError(loc, message); 1622 } 1623 1624 /// Helpers to get function type from arguments and result type. 1625 static mlir::FunctionType getFunctionType(std::optional<mlir::Type> resultType, 1626 llvm::ArrayRef<mlir::Value> arguments, 1627 fir::FirOpBuilder &builder) { 1628 llvm::SmallVector<mlir::Type> argTypes; 1629 for (mlir::Value arg : arguments) 1630 argTypes.push_back(arg.getType()); 1631 llvm::SmallVector<mlir::Type> resTypes; 1632 if (resultType) 1633 resTypes.push_back(*resultType); 1634 return mlir::FunctionType::get(builder.getModule().getContext(), argTypes, 1635 resTypes); 1636 } 1637 1638 /// fir::ExtendedValue to mlir::Value translation layer 1639 1640 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder, 1641 mlir::Location loc) { 1642 assert(val && "optional unhandled here"); 1643 mlir::Type type = val.getType(); 1644 mlir::Value base = val; 1645 mlir::IndexType indexType = builder.getIndexType(); 1646 llvm::SmallVector<mlir::Value> extents; 1647 1648 fir::factory::CharacterExprHelper charHelper{builder, loc}; 1649 // FIXME: we may want to allow non character scalar here. 1650 if (charHelper.isCharacterScalar(type)) 1651 return charHelper.toExtendedValue(val); 1652 1653 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type)) 1654 type = refType.getEleTy(); 1655 1656 if (auto arrayType = mlir::dyn_cast<fir::SequenceType>(type)) { 1657 type = arrayType.getEleTy(); 1658 for (fir::SequenceType::Extent extent : arrayType.getShape()) { 1659 if (extent == fir::SequenceType::getUnknownExtent()) 1660 break; 1661 extents.emplace_back( 1662 builder.createIntegerConstant(loc, indexType, extent)); 1663 } 1664 // Last extent might be missing in case of assumed-size. If more extents 1665 // could not be deduced from type, that's an error (a fir.box should 1666 // have been used in the interface). 1667 if (extents.size() + 1 < arrayType.getShape().size()) 1668 mlir::emitError(loc, "cannot retrieve array extents from type"); 1669 } else if (mlir::isa<fir::BoxType>(type) || 1670 mlir::isa<fir::RecordType>(type)) { 1671 fir::emitFatalError(loc, "not yet implemented: descriptor or derived type"); 1672 } 1673 1674 if (!extents.empty()) 1675 return fir::ArrayBoxValue{base, extents}; 1676 return base; 1677 } 1678 1679 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder, 1680 mlir::Location loc) { 1681 if (const fir::CharBoxValue *charBox = val.getCharBox()) { 1682 mlir::Value buffer = charBox->getBuffer(); 1683 auto buffTy = buffer.getType(); 1684 if (mlir::isa<mlir::FunctionType>(buffTy)) 1685 fir::emitFatalError( 1686 loc, "A character's buffer type cannot be a function type."); 1687 if (mlir::isa<fir::BoxCharType>(buffTy)) 1688 return buffer; 1689 return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar( 1690 buffer, charBox->getLen()); 1691 } 1692 1693 // FIXME: need to access other ExtendedValue variants and handle them 1694 // properly. 1695 return fir::getBase(val); 1696 } 1697 1698 //===----------------------------------------------------------------------===// 1699 // IntrinsicLibrary 1700 //===----------------------------------------------------------------------===// 1701 1702 static bool isIntrinsicModuleProcedure(llvm::StringRef name) { 1703 return name.starts_with("c_") || name.starts_with("compiler_") || 1704 name.starts_with("ieee_") || name.starts_with("__ppc_"); 1705 } 1706 1707 static bool isCoarrayIntrinsic(llvm::StringRef name) { 1708 return name.starts_with("atomic_") || name.starts_with("co_") || 1709 name.contains("image") || name.ends_with("cobound") || 1710 name == "team_number"; 1711 } 1712 1713 /// Return the generic name of an intrinsic module procedure specific name. 1714 /// Remove any "__builtin_" prefix, and any specific suffix of the form 1715 /// {_[ail]?[0-9]+}*, such as _1 or _a4. 1716 llvm::StringRef genericName(llvm::StringRef specificName) { 1717 const std::string builtin = "__builtin_"; 1718 llvm::StringRef name = specificName.starts_with(builtin) 1719 ? specificName.drop_front(builtin.size()) 1720 : specificName; 1721 size_t size = name.size(); 1722 if (isIntrinsicModuleProcedure(name)) 1723 while (isdigit(name[size - 1])) 1724 while (name[--size] != '_') 1725 ; 1726 return name.drop_back(name.size() - size); 1727 } 1728 1729 std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange> 1730 lookupRuntimeGenerator(llvm::StringRef name, bool isPPCTarget) { 1731 if (auto range = mathOps.equal_range(name); range.first != range.second) 1732 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>( 1733 range); 1734 // Search ppcMathOps only if targetting PowerPC arch 1735 if (isPPCTarget) 1736 if (auto range = checkPPCMathOperationsRange(name); 1737 range.first != range.second) 1738 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>( 1739 range); 1740 return std::nullopt; 1741 } 1742 1743 std::optional<IntrinsicHandlerEntry> 1744 lookupIntrinsicHandler(fir::FirOpBuilder &builder, 1745 llvm::StringRef intrinsicName, 1746 std::optional<mlir::Type> resultType) { 1747 llvm::StringRef name = genericName(intrinsicName); 1748 if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) 1749 return std::make_optional<IntrinsicHandlerEntry>(handler); 1750 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC(); 1751 // If targeting PowerPC, check PPC intrinsic handlers. 1752 if (isPPCTarget) 1753 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name)) 1754 return std::make_optional<IntrinsicHandlerEntry>(ppcHandler); 1755 // Subroutines should have a handler. 1756 if (!resultType) 1757 return std::nullopt; 1758 // Try the runtime if no special handler was defined for the 1759 // intrinsic being called. Maths runtime only has numerical elemental. 1760 if (auto runtimeGeneratorRange = lookupRuntimeGenerator(name, isPPCTarget)) 1761 return std::make_optional<IntrinsicHandlerEntry>(*runtimeGeneratorRange); 1762 return std::nullopt; 1763 } 1764 1765 /// Generate a TODO error message for an as yet unimplemented intrinsic. 1766 void crashOnMissingIntrinsic(mlir::Location loc, 1767 llvm::StringRef intrinsicName) { 1768 llvm::StringRef name = genericName(intrinsicName); 1769 if (isIntrinsicModuleProcedure(name)) 1770 TODO(loc, "intrinsic module procedure: " + llvm::Twine(name)); 1771 else if (isCoarrayIntrinsic(name)) 1772 TODO(loc, "coarray: intrinsic " + llvm::Twine(name)); 1773 else 1774 TODO(loc, "intrinsic: " + llvm::Twine(name.upper())); 1775 } 1776 1777 template <typename GeneratorType> 1778 fir::ExtendedValue IntrinsicLibrary::genElementalCall( 1779 GeneratorType generator, llvm::StringRef name, mlir::Type resultType, 1780 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) { 1781 llvm::SmallVector<mlir::Value> scalarArgs; 1782 for (const fir::ExtendedValue &arg : args) 1783 if (arg.getUnboxed() || arg.getCharBox()) 1784 scalarArgs.emplace_back(fir::getBase(arg)); 1785 else 1786 fir::emitFatalError(loc, "nonscalar intrinsic argument"); 1787 if (outline) 1788 return outlineInWrapper(generator, name, resultType, scalarArgs); 1789 return invokeGenerator(generator, resultType, scalarArgs); 1790 } 1791 1792 template <> 1793 fir::ExtendedValue 1794 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>( 1795 ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType, 1796 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) { 1797 for (const fir::ExtendedValue &arg : args) { 1798 auto *box = arg.getBoxOf<fir::BoxValue>(); 1799 if (!arg.getUnboxed() && !arg.getCharBox() && 1800 !(box && fir::isScalarBoxedRecordType(fir::getBase(*box).getType()))) 1801 fir::emitFatalError(loc, "nonscalar intrinsic argument"); 1802 } 1803 if (outline) 1804 return outlineInExtendedWrapper(generator, name, resultType, args); 1805 return std::invoke(generator, *this, resultType, args); 1806 } 1807 1808 template <> 1809 fir::ExtendedValue 1810 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>( 1811 SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType, 1812 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) { 1813 for (const fir::ExtendedValue &arg : args) 1814 if (!arg.getUnboxed() && !arg.getCharBox()) 1815 // fir::emitFatalError(loc, "nonscalar intrinsic argument"); 1816 crashOnMissingIntrinsic(loc, name); 1817 if (outline) 1818 return outlineInExtendedWrapper(generator, name, resultType, args); 1819 std::invoke(generator, *this, args); 1820 return mlir::Value(); 1821 } 1822 1823 template <> 1824 fir::ExtendedValue 1825 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::DualGenerator>( 1826 DualGenerator generator, llvm::StringRef name, mlir::Type resultType, 1827 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) { 1828 assert(resultType.getImpl() && "expect elemental intrinsic to be functions"); 1829 1830 for (const fir::ExtendedValue &arg : args) 1831 if (!arg.getUnboxed() && !arg.getCharBox()) 1832 // fir::emitFatalError(loc, "nonscalar intrinsic argument"); 1833 crashOnMissingIntrinsic(loc, name); 1834 if (outline) 1835 return outlineInExtendedWrapper(generator, name, resultType, args); 1836 1837 return std::invoke(generator, *this, std::optional<mlir::Type>{resultType}, 1838 args); 1839 } 1840 1841 static fir::ExtendedValue 1842 invokeHandler(IntrinsicLibrary::ElementalGenerator generator, 1843 const IntrinsicHandler &handler, 1844 std::optional<mlir::Type> resultType, 1845 llvm::ArrayRef<fir::ExtendedValue> args, bool outline, 1846 IntrinsicLibrary &lib) { 1847 assert(resultType && "expect elemental intrinsic to be functions"); 1848 return lib.genElementalCall(generator, handler.name, *resultType, args, 1849 outline); 1850 } 1851 1852 static fir::ExtendedValue 1853 invokeHandler(IntrinsicLibrary::ExtendedGenerator generator, 1854 const IntrinsicHandler &handler, 1855 std::optional<mlir::Type> resultType, 1856 llvm::ArrayRef<fir::ExtendedValue> args, bool outline, 1857 IntrinsicLibrary &lib) { 1858 assert(resultType && "expect intrinsic function"); 1859 if (handler.isElemental) 1860 return lib.genElementalCall(generator, handler.name, *resultType, args, 1861 outline); 1862 if (outline) 1863 return lib.outlineInExtendedWrapper(generator, handler.name, *resultType, 1864 args); 1865 return std::invoke(generator, lib, *resultType, args); 1866 } 1867 1868 static fir::ExtendedValue 1869 invokeHandler(IntrinsicLibrary::SubroutineGenerator generator, 1870 const IntrinsicHandler &handler, 1871 std::optional<mlir::Type> resultType, 1872 llvm::ArrayRef<fir::ExtendedValue> args, bool outline, 1873 IntrinsicLibrary &lib) { 1874 if (handler.isElemental) 1875 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args, 1876 outline); 1877 if (outline) 1878 return lib.outlineInExtendedWrapper(generator, handler.name, resultType, 1879 args); 1880 std::invoke(generator, lib, args); 1881 return mlir::Value{}; 1882 } 1883 1884 static fir::ExtendedValue 1885 invokeHandler(IntrinsicLibrary::DualGenerator generator, 1886 const IntrinsicHandler &handler, 1887 std::optional<mlir::Type> resultType, 1888 llvm::ArrayRef<fir::ExtendedValue> args, bool outline, 1889 IntrinsicLibrary &lib) { 1890 if (handler.isElemental) 1891 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args, 1892 outline); 1893 if (outline) 1894 return lib.outlineInExtendedWrapper(generator, handler.name, resultType, 1895 args); 1896 1897 return std::invoke(generator, lib, resultType, args); 1898 } 1899 1900 static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper( 1901 const IntrinsicHandler *handler, std::optional<mlir::Type> resultType, 1902 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) { 1903 assert(handler && "must be set"); 1904 bool outline = handler->outline || outlineAllIntrinsics; 1905 return {Fortran::common::visit( 1906 [&](auto &generator) -> fir::ExtendedValue { 1907 return invokeHandler(generator, *handler, resultType, args, 1908 outline, lib); 1909 }, 1910 handler->generator), 1911 lib.resultMustBeFreed}; 1912 } 1913 1914 static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper( 1915 const IntrinsicHandlerEntry::RuntimeGeneratorRange &, mlir::FunctionType, 1916 fir::FirOpBuilder &, mlir::Location); 1917 1918 static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper( 1919 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range, 1920 std::optional<mlir::Type> resultType, 1921 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) { 1922 assert(resultType.has_value() && "RuntimeGenerator are for functions only"); 1923 assert(range.first != nullptr && "range should not be empty"); 1924 fir::FirOpBuilder &builder = lib.builder; 1925 mlir::Location loc = lib.loc; 1926 llvm::StringRef name = range.first->key; 1927 // FIXME: using toValue to get the type won't work with array arguments. 1928 llvm::SmallVector<mlir::Value> mlirArgs; 1929 for (const fir::ExtendedValue &extendedVal : args) { 1930 mlir::Value val = toValue(extendedVal, builder, loc); 1931 if (!val) 1932 // If an absent optional gets there, most likely its handler has just 1933 // not yet been defined. 1934 crashOnMissingIntrinsic(loc, name); 1935 mlirArgs.emplace_back(val); 1936 } 1937 mlir::FunctionType soughtFuncType = 1938 getFunctionType(*resultType, mlirArgs, builder); 1939 1940 IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator = 1941 getRuntimeCallGeneratorHelper(range, soughtFuncType, builder, loc); 1942 return {lib.genElementalCall(runtimeCallGenerator, name, *resultType, args, 1943 /*outline=*/outlineAllIntrinsics), 1944 lib.resultMustBeFreed}; 1945 } 1946 1947 std::pair<fir::ExtendedValue, bool> 1948 genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc, 1949 const IntrinsicHandlerEntry &intrinsic, 1950 std::optional<mlir::Type> resultType, 1951 llvm::ArrayRef<fir::ExtendedValue> args, 1952 Fortran::lower::AbstractConverter *converter) { 1953 IntrinsicLibrary library{builder, loc, converter}; 1954 return std::visit( 1955 [&](auto handler) -> auto { 1956 return genIntrinsicCallHelper(handler, resultType, args, library); 1957 }, 1958 intrinsic.entry); 1959 } 1960 1961 std::pair<fir::ExtendedValue, bool> 1962 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName, 1963 std::optional<mlir::Type> resultType, 1964 llvm::ArrayRef<fir::ExtendedValue> args) { 1965 std::optional<IntrinsicHandlerEntry> intrinsic = 1966 lookupIntrinsicHandler(builder, specificName, resultType); 1967 if (!intrinsic.has_value()) 1968 crashOnMissingIntrinsic(loc, specificName); 1969 return std::visit( 1970 [&](auto handler) -> auto { 1971 return genIntrinsicCallHelper(handler, resultType, args, *this); 1972 }, 1973 intrinsic->entry); 1974 } 1975 1976 mlir::Value 1977 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator, 1978 mlir::Type resultType, 1979 llvm::ArrayRef<mlir::Value> args) { 1980 return std::invoke(generator, *this, resultType, args); 1981 } 1982 1983 mlir::Value 1984 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator, 1985 mlir::Type resultType, 1986 llvm::ArrayRef<mlir::Value> args) { 1987 return generator(builder, loc, args); 1988 } 1989 1990 mlir::Value 1991 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator, 1992 mlir::Type resultType, 1993 llvm::ArrayRef<mlir::Value> args) { 1994 llvm::SmallVector<fir::ExtendedValue> extendedArgs; 1995 for (mlir::Value arg : args) 1996 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); 1997 auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs); 1998 return toValue(extendedResult, builder, loc); 1999 } 2000 2001 mlir::Value 2002 IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator, 2003 llvm::ArrayRef<mlir::Value> args) { 2004 llvm::SmallVector<fir::ExtendedValue> extendedArgs; 2005 for (mlir::Value arg : args) 2006 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); 2007 std::invoke(generator, *this, extendedArgs); 2008 return {}; 2009 } 2010 2011 mlir::Value 2012 IntrinsicLibrary::invokeGenerator(DualGenerator generator, 2013 llvm::ArrayRef<mlir::Value> args) { 2014 llvm::SmallVector<fir::ExtendedValue> extendedArgs; 2015 for (mlir::Value arg : args) 2016 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); 2017 std::invoke(generator, *this, std::optional<mlir::Type>{}, extendedArgs); 2018 return {}; 2019 } 2020 2021 mlir::Value 2022 IntrinsicLibrary::invokeGenerator(DualGenerator generator, 2023 mlir::Type resultType, 2024 llvm::ArrayRef<mlir::Value> args) { 2025 llvm::SmallVector<fir::ExtendedValue> extendedArgs; 2026 for (mlir::Value arg : args) 2027 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); 2028 2029 if (resultType.getImpl() == nullptr) { 2030 // TODO: 2031 assert(false && "result type is null"); 2032 } 2033 2034 auto extendedResult = std::invoke( 2035 generator, *this, std::optional<mlir::Type>{resultType}, extendedArgs); 2036 return toValue(extendedResult, builder, loc); 2037 } 2038 2039 //===----------------------------------------------------------------------===// 2040 // Intrinsic Procedure Mangling 2041 //===----------------------------------------------------------------------===// 2042 2043 /// Helper to encode type into string for intrinsic procedure names. 2044 /// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not 2045 /// suitable for function names. 2046 static std::string typeToString(mlir::Type t) { 2047 if (auto refT{mlir::dyn_cast<fir::ReferenceType>(t)}) 2048 return "ref_" + typeToString(refT.getEleTy()); 2049 if (auto i{mlir::dyn_cast<mlir::IntegerType>(t)}) { 2050 return "i" + std::to_string(i.getWidth()); 2051 } 2052 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(t)}) { 2053 auto eleTy = mlir::cast<mlir::FloatType>(cplx.getElementType()); 2054 return "z" + std::to_string(eleTy.getWidth()); 2055 } 2056 if (auto f{mlir::dyn_cast<mlir::FloatType>(t)}) { 2057 return "f" + std::to_string(f.getWidth()); 2058 } 2059 if (auto logical{mlir::dyn_cast<fir::LogicalType>(t)}) { 2060 return "l" + std::to_string(logical.getFKind()); 2061 } 2062 if (auto character{mlir::dyn_cast<fir::CharacterType>(t)}) { 2063 return "c" + std::to_string(character.getFKind()); 2064 } 2065 if (auto boxCharacter{mlir::dyn_cast<fir::BoxCharType>(t)}) { 2066 return "bc" + std::to_string(boxCharacter.getEleTy().getFKind()); 2067 } 2068 llvm_unreachable("no mangling for type"); 2069 } 2070 2071 /// Returns a name suitable to define mlir functions for Fortran intrinsic 2072 /// Procedure. These names are guaranteed to not conflict with user defined 2073 /// procedures. This is needed to implement Fortran generic intrinsics as 2074 /// several mlir functions specialized for the argument types. 2075 /// The result is guaranteed to be distinct for different mlir::FunctionType 2076 /// arguments. The mangling pattern is: 2077 /// fir.<generic name>.<result type>.<arg type>... 2078 /// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4 2079 /// For subroutines no result type is return but in order to still provide 2080 /// a unique mangled name, we use "void" as the return type. As in: 2081 /// fir.<generic name>.void.<arg type>... 2082 /// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i4 2083 static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic, 2084 mlir::FunctionType funTy) { 2085 std::string name = "fir."; 2086 name.append(intrinsic.str()).append("."); 2087 if (funTy.getNumResults() == 1) 2088 name.append(typeToString(funTy.getResult(0))); 2089 else if (funTy.getNumResults() == 0) 2090 name.append("void"); 2091 else 2092 llvm_unreachable("more than one result value for function"); 2093 unsigned e = funTy.getNumInputs(); 2094 for (decltype(e) i = 0; i < e; ++i) 2095 name.append(".").append(typeToString(funTy.getInput(i))); 2096 return name; 2097 } 2098 2099 template <typename GeneratorType> 2100 mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, 2101 llvm::StringRef name, 2102 mlir::FunctionType funcType, 2103 bool loadRefArguments) { 2104 std::string wrapperName = mangleIntrinsicProcedure(name, funcType); 2105 mlir::func::FuncOp function = builder.getNamedFunction(wrapperName); 2106 if (!function) { 2107 // First time this wrapper is needed, build it. 2108 function = builder.createFunction(loc, wrapperName, funcType); 2109 function->setAttr("fir.intrinsic", builder.getUnitAttr()); 2110 fir::factory::setInternalLinkage(function); 2111 function.addEntryBlock(); 2112 2113 // Create local context to emit code into the newly created function 2114 // This new function is not linked to a source file location, only 2115 // its calls will be. 2116 auto localBuilder = std::make_unique<fir::FirOpBuilder>( 2117 function, builder.getKindMap(), builder.getMLIRSymbolTable()); 2118 localBuilder->setFastMathFlags(builder.getFastMathFlags()); 2119 localBuilder->setInsertionPointToStart(&function.front()); 2120 // Location of code inside wrapper of the wrapper is independent from 2121 // the location of the intrinsic call. 2122 mlir::Location localLoc = localBuilder->getUnknownLoc(); 2123 llvm::SmallVector<mlir::Value> localArguments; 2124 for (mlir::BlockArgument bArg : function.front().getArguments()) { 2125 auto refType = mlir::dyn_cast<fir::ReferenceType>(bArg.getType()); 2126 if (loadRefArguments && refType) { 2127 auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg); 2128 localArguments.push_back(loaded); 2129 } else { 2130 localArguments.push_back(bArg); 2131 } 2132 } 2133 2134 IntrinsicLibrary localLib{*localBuilder, localLoc}; 2135 2136 if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) { 2137 localLib.invokeGenerator(generator, localArguments); 2138 localBuilder->create<mlir::func::ReturnOp>(localLoc); 2139 } else { 2140 assert(funcType.getNumResults() == 1 && 2141 "expect one result for intrinsic function wrapper type"); 2142 mlir::Type resultType = funcType.getResult(0); 2143 auto result = 2144 localLib.invokeGenerator(generator, resultType, localArguments); 2145 localBuilder->create<mlir::func::ReturnOp>(localLoc, result); 2146 } 2147 } else { 2148 // Wrapper was already built, ensure it has the sought type 2149 assert(function.getFunctionType() == funcType && 2150 "conflict between intrinsic wrapper types"); 2151 } 2152 return function; 2153 } 2154 2155 /// Helpers to detect absent optional (not yet supported in outlining). 2156 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) { 2157 for (const mlir::Value &arg : args) 2158 if (!arg) 2159 return true; 2160 return false; 2161 } 2162 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) { 2163 for (const fir::ExtendedValue &arg : args) 2164 if (!fir::getBase(arg)) 2165 return true; 2166 return false; 2167 } 2168 2169 template <typename GeneratorType> 2170 mlir::Value 2171 IntrinsicLibrary::outlineInWrapper(GeneratorType generator, 2172 llvm::StringRef name, mlir::Type resultType, 2173 llvm::ArrayRef<mlir::Value> args) { 2174 if (hasAbsentOptional(args)) { 2175 // TODO: absent optional in outlining is an issue: we cannot just ignore 2176 // them. Needs a better interface here. The issue is that we cannot easily 2177 // tell that a value is optional or not here if it is presents. And if it is 2178 // absent, we cannot tell what it type should be. 2179 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) + 2180 " with absent optional argument"); 2181 } 2182 2183 mlir::FunctionType funcType = getFunctionType(resultType, args, builder); 2184 std::string funcName{name}; 2185 llvm::raw_string_ostream nameOS{funcName}; 2186 if (std::string fmfString{builder.getFastMathFlagsString()}; 2187 !fmfString.empty()) { 2188 nameOS << '.' << fmfString; 2189 } 2190 mlir::func::FuncOp wrapper = getWrapper(generator, funcName, funcType); 2191 return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0); 2192 } 2193 2194 template <typename GeneratorType> 2195 fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper( 2196 GeneratorType generator, llvm::StringRef name, 2197 std::optional<mlir::Type> resultType, 2198 llvm::ArrayRef<fir::ExtendedValue> args) { 2199 if (hasAbsentOptional(args)) 2200 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) + 2201 " with absent optional argument"); 2202 llvm::SmallVector<mlir::Value> mlirArgs; 2203 for (const auto &extendedVal : args) 2204 mlirArgs.emplace_back(toValue(extendedVal, builder, loc)); 2205 mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder); 2206 mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType); 2207 auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs); 2208 if (resultType) 2209 return toExtendedValue(call.getResult(0), builder, loc); 2210 // Subroutine calls 2211 return mlir::Value{}; 2212 } 2213 2214 static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper( 2215 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range, 2216 mlir::FunctionType soughtFuncType, fir::FirOpBuilder &builder, 2217 mlir::Location loc) { 2218 assert(range.first != nullptr && "range should not be empty"); 2219 llvm::StringRef name = range.first->key; 2220 // Look for a dedicated math operation generator, which 2221 // normally produces a single MLIR operation implementing 2222 // the math operation. 2223 const MathOperation *bestNearMatch = nullptr; 2224 FunctionDistance bestMatchDistance; 2225 const MathOperation *mathOp = searchMathOperation( 2226 builder, range, soughtFuncType, &bestNearMatch, bestMatchDistance); 2227 if (!mathOp && bestNearMatch) { 2228 // Use the best near match, optionally issuing an error, 2229 // if types conversions cause precision loss. 2230 checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, builder, loc); 2231 mathOp = bestNearMatch; 2232 } 2233 2234 if (!mathOp) { 2235 std::string nameAndType; 2236 llvm::raw_string_ostream sstream(nameAndType); 2237 sstream << name << "\nrequested type: " << soughtFuncType; 2238 crashOnMissingIntrinsic(loc, nameAndType); 2239 } 2240 2241 mlir::FunctionType actualFuncType = 2242 mathOp->typeGenerator(builder.getContext(), builder); 2243 2244 assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() && 2245 actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() && 2246 actualFuncType.getNumResults() == 1 && "Bad intrinsic match"); 2247 2248 return [actualFuncType, mathOp, 2249 soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc, 2250 llvm::ArrayRef<mlir::Value> args) { 2251 llvm::SmallVector<mlir::Value> convertedArguments; 2252 for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args)) 2253 convertedArguments.push_back(builder.createConvert(loc, fst, snd)); 2254 mlir::Value result = mathOp->funcGenerator( 2255 builder, loc, *mathOp, actualFuncType, convertedArguments); 2256 mlir::Type soughtType = soughtFuncType.getResult(0); 2257 return builder.createConvert(loc, soughtType, result); 2258 }; 2259 } 2260 2261 IntrinsicLibrary::RuntimeCallGenerator 2262 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name, 2263 mlir::FunctionType soughtFuncType) { 2264 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC(); 2265 std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange> range = 2266 lookupRuntimeGenerator(name, isPPCTarget); 2267 if (!range.has_value()) 2268 crashOnMissingIntrinsic(loc, name); 2269 return getRuntimeCallGeneratorHelper(*range, soughtFuncType, builder, loc); 2270 } 2271 2272 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr( 2273 llvm::StringRef name, mlir::FunctionType signature) { 2274 // Unrestricted intrinsics signature follows implicit rules: argument 2275 // are passed by references. But the runtime versions expect values. 2276 // So instead of duplicating the runtime, just have the wrappers loading 2277 // this before calling the code generators. 2278 bool loadRefArguments = true; 2279 mlir::func::FuncOp funcOp; 2280 if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) 2281 funcOp = Fortran::common::visit( 2282 [&](auto generator) { 2283 return getWrapper(generator, name, signature, loadRefArguments); 2284 }, 2285 handler->generator); 2286 2287 if (!funcOp) { 2288 llvm::SmallVector<mlir::Type> argTypes; 2289 for (mlir::Type type : signature.getInputs()) { 2290 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type)) 2291 argTypes.push_back(refType.getEleTy()); 2292 else 2293 argTypes.push_back(type); 2294 } 2295 mlir::FunctionType soughtFuncType = 2296 builder.getFunctionType(argTypes, signature.getResults()); 2297 IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator = 2298 getRuntimeCallGenerator(name, soughtFuncType); 2299 funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments); 2300 } 2301 2302 return mlir::SymbolRefAttr::get(funcOp); 2303 } 2304 2305 fir::ExtendedValue 2306 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox, 2307 mlir::Type resultType, 2308 llvm::StringRef intrinsicName) { 2309 fir::ExtendedValue res = 2310 fir::factory::genMutableBoxRead(builder, loc, resultMutableBox); 2311 return res.match( 2312 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue { 2313 setResultMustBeFreed(); 2314 return box; 2315 }, 2316 [&](const fir::BoxValue &box) -> fir::ExtendedValue { 2317 setResultMustBeFreed(); 2318 return box; 2319 }, 2320 [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue { 2321 setResultMustBeFreed(); 2322 return box; 2323 }, 2324 [&](const mlir::Value &tempAddr) -> fir::ExtendedValue { 2325 auto load = builder.create<fir::LoadOp>(loc, resultType, tempAddr); 2326 // Temp can be freed right away since it was loaded. 2327 builder.create<fir::FreeMemOp>(loc, tempAddr); 2328 return load; 2329 }, 2330 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { 2331 setResultMustBeFreed(); 2332 return box; 2333 }, 2334 [&](const auto &) -> fir::ExtendedValue { 2335 fir::emitFatalError(loc, "unexpected result for " + intrinsicName); 2336 }); 2337 } 2338 2339 //===----------------------------------------------------------------------===// 2340 // Code generators for the intrinsic 2341 //===----------------------------------------------------------------------===// 2342 2343 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, 2344 mlir::Type resultType, 2345 llvm::ArrayRef<mlir::Value> args) { 2346 mlir::FunctionType soughtFuncType = 2347 getFunctionType(resultType, args, builder); 2348 return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args); 2349 } 2350 2351 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, 2352 llvm::ArrayRef<mlir::Value> args) { 2353 // There can be an optional kind in second argument. 2354 assert(args.size() >= 1); 2355 return builder.convertWithSemantics(loc, resultType, args[0]); 2356 } 2357 2358 // ABORT 2359 void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) { 2360 assert(args.size() == 0); 2361 fir::runtime::genAbort(builder, loc); 2362 } 2363 2364 // ABS 2365 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, 2366 llvm::ArrayRef<mlir::Value> args) { 2367 assert(args.size() == 1); 2368 mlir::Value arg = args[0]; 2369 mlir::Type type = arg.getType(); 2370 if (fir::isa_real(type) || fir::isa_complex(type)) { 2371 // Runtime call to fp abs. An alternative would be to use mlir 2372 // math::AbsFOp but it does not support all fir floating point types. 2373 return genRuntimeCall("abs", resultType, args); 2374 } 2375 if (auto intType = mlir::dyn_cast<mlir::IntegerType>(type)) { 2376 // At the time of this implementation there is no abs op in mlir. 2377 // So, implement abs here without branching. 2378 mlir::Value shift = 2379 builder.createIntegerConstant(loc, intType, intType.getWidth() - 1); 2380 auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift); 2381 auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask); 2382 return builder.create<mlir::arith::SubIOp>(loc, xored, mask); 2383 } 2384 llvm_unreachable("unexpected type in ABS argument"); 2385 } 2386 2387 // ACOSD 2388 mlir::Value IntrinsicLibrary::genAcosd(mlir::Type resultType, 2389 llvm::ArrayRef<mlir::Value> args) { 2390 assert(args.size() == 1); 2391 mlir::MLIRContext *context = builder.getContext(); 2392 mlir::FunctionType ftype = 2393 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 2394 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 2395 mlir::Value dfactor = builder.createRealConstant( 2396 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0)); 2397 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor); 2398 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor); 2399 return getRuntimeCallGenerator("acos", ftype)(builder, loc, {arg}); 2400 } 2401 2402 // ADJUSTL & ADJUSTR 2403 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc, 2404 mlir::Value, mlir::Value)> 2405 fir::ExtendedValue 2406 IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType, 2407 llvm::ArrayRef<fir::ExtendedValue> args) { 2408 assert(args.size() == 1); 2409 mlir::Value string = builder.createBox(loc, args[0]); 2410 // Create a mutable fir.box to be passed to the runtime for the result. 2411 fir::MutableBoxValue resultMutableBox = 2412 fir::factory::createTempMutableBox(builder, loc, resultType); 2413 mlir::Value resultIrBox = 2414 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 2415 2416 // Call the runtime -- the runtime will allocate the result. 2417 CallRuntime(builder, loc, resultIrBox, string); 2418 // Read result from mutable fir.box and add it to the list of temps to be 2419 // finalized by the StatementContext. 2420 return readAndAddCleanUp(resultMutableBox, resultType, "ADJUSTL or ADJUSTR"); 2421 } 2422 2423 // AIMAG 2424 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, 2425 llvm::ArrayRef<mlir::Value> args) { 2426 assert(args.size() == 1); 2427 return fir::factory::Complex{builder, loc}.extractComplexPart( 2428 args[0], /*isImagPart=*/true); 2429 } 2430 2431 // AINT 2432 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType, 2433 llvm::ArrayRef<mlir::Value> args) { 2434 assert(args.size() >= 1 && args.size() <= 2); 2435 // Skip optional kind argument to search the runtime; it is already reflected 2436 // in result type. 2437 return genRuntimeCall("aint", resultType, {args[0]}); 2438 } 2439 2440 // ALL 2441 fir::ExtendedValue 2442 IntrinsicLibrary::genAll(mlir::Type resultType, 2443 llvm::ArrayRef<fir::ExtendedValue> args) { 2444 2445 assert(args.size() == 2); 2446 // Handle required mask argument 2447 mlir::Value mask = builder.createBox(loc, args[0]); 2448 2449 fir::BoxValue maskArry = builder.createBox(loc, args[0]); 2450 int rank = maskArry.rank(); 2451 assert(rank >= 1); 2452 2453 // Handle optional dim argument 2454 bool absentDim = isStaticallyAbsent(args[1]); 2455 mlir::Value dim = 2456 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) 2457 : fir::getBase(args[1]); 2458 2459 if (rank == 1 || absentDim) 2460 return builder.createConvert(loc, resultType, 2461 fir::runtime::genAll(builder, loc, mask, dim)); 2462 2463 // else use the result descriptor AllDim() intrinsic 2464 2465 // Create mutable fir.box to be passed to the runtime for the result. 2466 2467 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 2468 fir::MutableBoxValue resultMutableBox = 2469 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 2470 mlir::Value resultIrBox = 2471 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 2472 // Call runtime. The runtime is allocating the result. 2473 fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim); 2474 return readAndAddCleanUp(resultMutableBox, resultType, "ALL"); 2475 } 2476 2477 // ALLOCATED 2478 fir::ExtendedValue 2479 IntrinsicLibrary::genAllocated(mlir::Type resultType, 2480 llvm::ArrayRef<fir::ExtendedValue> args) { 2481 assert(args.size() == 1); 2482 return args[0].match( 2483 [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue { 2484 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x); 2485 }, 2486 [&](const auto &) -> fir::ExtendedValue { 2487 fir::emitFatalError(loc, 2488 "allocated arg not lowered to MutableBoxValue"); 2489 }); 2490 } 2491 2492 // ANINT 2493 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType, 2494 llvm::ArrayRef<mlir::Value> args) { 2495 assert(args.size() >= 1 && args.size() <= 2); 2496 // Skip optional kind argument to search the runtime; it is already reflected 2497 // in result type. 2498 return genRuntimeCall("anint", resultType, {args[0]}); 2499 } 2500 2501 // ANY 2502 fir::ExtendedValue 2503 IntrinsicLibrary::genAny(mlir::Type resultType, 2504 llvm::ArrayRef<fir::ExtendedValue> args) { 2505 2506 assert(args.size() == 2); 2507 // Handle required mask argument 2508 mlir::Value mask = builder.createBox(loc, args[0]); 2509 2510 fir::BoxValue maskArry = builder.createBox(loc, args[0]); 2511 int rank = maskArry.rank(); 2512 assert(rank >= 1); 2513 2514 // Handle optional dim argument 2515 bool absentDim = isStaticallyAbsent(args[1]); 2516 mlir::Value dim = 2517 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) 2518 : fir::getBase(args[1]); 2519 2520 if (rank == 1 || absentDim) 2521 return builder.createConvert(loc, resultType, 2522 fir::runtime::genAny(builder, loc, mask, dim)); 2523 2524 // else use the result descriptor AnyDim() intrinsic 2525 2526 // Create mutable fir.box to be passed to the runtime for the result. 2527 2528 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 2529 fir::MutableBoxValue resultMutableBox = 2530 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 2531 mlir::Value resultIrBox = 2532 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 2533 // Call runtime. The runtime is allocating the result. 2534 fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim); 2535 return readAndAddCleanUp(resultMutableBox, resultType, "ANY"); 2536 } 2537 2538 // ASIND 2539 mlir::Value IntrinsicLibrary::genAsind(mlir::Type resultType, 2540 llvm::ArrayRef<mlir::Value> args) { 2541 assert(args.size() == 1); 2542 mlir::MLIRContext *context = builder.getContext(); 2543 mlir::FunctionType ftype = 2544 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 2545 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 2546 mlir::Value dfactor = builder.createRealConstant( 2547 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0)); 2548 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor); 2549 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor); 2550 return getRuntimeCallGenerator("asin", ftype)(builder, loc, {arg}); 2551 } 2552 2553 // ATAND, ATAN2D 2554 mlir::Value IntrinsicLibrary::genAtand(mlir::Type resultType, 2555 llvm::ArrayRef<mlir::Value> args) { 2556 // assert for: atand(X), atand(Y,X), atan2d(Y,X) 2557 assert(args.size() >= 1 && args.size() <= 2); 2558 2559 mlir::MLIRContext *context = builder.getContext(); 2560 mlir::Value atan; 2561 2562 // atand = atan * 180/pi 2563 if (args.size() == 2) { 2564 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]), 2565 fir::getBase(args[1])); 2566 } else { 2567 mlir::FunctionType ftype = 2568 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 2569 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args); 2570 } 2571 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 2572 mlir::Value dfactor = builder.createRealConstant( 2573 loc, mlir::Float64Type::get(context), llvm::APFloat(180.0) / pi); 2574 mlir::Value factor = builder.createConvert(loc, resultType, dfactor); 2575 return builder.create<mlir::arith::MulFOp>(loc, atan, factor); 2576 } 2577 2578 // ATANPI, ATAN2PI 2579 mlir::Value IntrinsicLibrary::genAtanpi(mlir::Type resultType, 2580 llvm::ArrayRef<mlir::Value> args) { 2581 // assert for: atanpi(X), atanpi(Y,X), atan2pi(Y,X) 2582 assert(args.size() >= 1 && args.size() <= 2); 2583 2584 mlir::Value atan; 2585 mlir::MLIRContext *context = builder.getContext(); 2586 2587 // atanpi = atan / pi 2588 if (args.size() == 2) { 2589 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]), 2590 fir::getBase(args[1])); 2591 } else { 2592 mlir::FunctionType ftype = 2593 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 2594 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args); 2595 } 2596 llvm::APFloat inv_pi = llvm::APFloat(llvm::numbers::inv_pi); 2597 mlir::Value dfactor = 2598 builder.createRealConstant(loc, mlir::Float64Type::get(context), inv_pi); 2599 mlir::Value factor = builder.createConvert(loc, resultType, dfactor); 2600 return builder.create<mlir::arith::MulFOp>(loc, atan, factor); 2601 } 2602 2603 static mlir::Value genAtomBinOp(fir::FirOpBuilder &builder, mlir::Location &loc, 2604 mlir::LLVM::AtomicBinOp binOp, mlir::Value arg0, 2605 mlir::Value arg1) { 2606 auto llvmPointerType = mlir::LLVM::LLVMPointerType::get(builder.getContext()); 2607 arg0 = builder.createConvert(loc, llvmPointerType, arg0); 2608 return builder.create<mlir::LLVM::AtomicRMWOp>( 2609 loc, binOp, arg0, arg1, mlir::LLVM::AtomicOrdering::seq_cst); 2610 } 2611 2612 mlir::Value IntrinsicLibrary::genAtomicAdd(mlir::Type resultType, 2613 llvm::ArrayRef<mlir::Value> args) { 2614 assert(args.size() == 2); 2615 2616 mlir::LLVM::AtomicBinOp binOp = 2617 mlir::isa<mlir::IntegerType>(args[1].getType()) 2618 ? mlir::LLVM::AtomicBinOp::add 2619 : mlir::LLVM::AtomicBinOp::fadd; 2620 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2621 } 2622 2623 mlir::Value IntrinsicLibrary::genAtomicSub(mlir::Type resultType, 2624 llvm::ArrayRef<mlir::Value> args) { 2625 assert(args.size() == 2); 2626 2627 mlir::LLVM::AtomicBinOp binOp = 2628 mlir::isa<mlir::IntegerType>(args[1].getType()) 2629 ? mlir::LLVM::AtomicBinOp::sub 2630 : mlir::LLVM::AtomicBinOp::fsub; 2631 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2632 } 2633 2634 mlir::Value IntrinsicLibrary::genAtomicAnd(mlir::Type resultType, 2635 llvm::ArrayRef<mlir::Value> args) { 2636 assert(args.size() == 2); 2637 assert(mlir::isa<mlir::IntegerType>(args[1].getType())); 2638 2639 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::_and; 2640 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2641 } 2642 2643 mlir::Value IntrinsicLibrary::genAtomicOr(mlir::Type resultType, 2644 llvm::ArrayRef<mlir::Value> args) { 2645 assert(args.size() == 2); 2646 assert(mlir::isa<mlir::IntegerType>(args[1].getType())); 2647 2648 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::_or; 2649 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2650 } 2651 2652 mlir::Value IntrinsicLibrary::genAtomicDec(mlir::Type resultType, 2653 llvm::ArrayRef<mlir::Value> args) { 2654 assert(args.size() == 2); 2655 assert(mlir::isa<mlir::IntegerType>(args[1].getType())); 2656 2657 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::udec_wrap; 2658 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2659 } 2660 2661 mlir::Value IntrinsicLibrary::genAtomicInc(mlir::Type resultType, 2662 llvm::ArrayRef<mlir::Value> args) { 2663 assert(args.size() == 2); 2664 assert(mlir::isa<mlir::IntegerType>(args[1].getType())); 2665 2666 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::uinc_wrap; 2667 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2668 } 2669 2670 mlir::Value IntrinsicLibrary::genAtomicMax(mlir::Type resultType, 2671 llvm::ArrayRef<mlir::Value> args) { 2672 assert(args.size() == 2); 2673 2674 mlir::LLVM::AtomicBinOp binOp = 2675 mlir::isa<mlir::IntegerType>(args[1].getType()) 2676 ? mlir::LLVM::AtomicBinOp::max 2677 : mlir::LLVM::AtomicBinOp::fmax; 2678 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2679 } 2680 2681 mlir::Value IntrinsicLibrary::genAtomicMin(mlir::Type resultType, 2682 llvm::ArrayRef<mlir::Value> args) { 2683 assert(args.size() == 2); 2684 2685 mlir::LLVM::AtomicBinOp binOp = 2686 mlir::isa<mlir::IntegerType>(args[1].getType()) 2687 ? mlir::LLVM::AtomicBinOp::min 2688 : mlir::LLVM::AtomicBinOp::fmin; 2689 return genAtomBinOp(builder, loc, binOp, args[0], args[1]); 2690 } 2691 2692 // ASSOCIATED 2693 fir::ExtendedValue 2694 IntrinsicLibrary::genAssociated(mlir::Type resultType, 2695 llvm::ArrayRef<fir::ExtendedValue> args) { 2696 assert(args.size() == 2); 2697 mlir::Type ptrTy = fir::getBase(args[0]).getType(); 2698 if (ptrTy && (fir::isBoxProcAddressType(ptrTy) || 2699 mlir::isa<fir::BoxProcType>(ptrTy))) { 2700 mlir::Value pointerBoxProc = 2701 fir::isBoxProcAddressType(ptrTy) 2702 ? builder.create<fir::LoadOp>(loc, fir::getBase(args[0])) 2703 : fir::getBase(args[0]); 2704 mlir::Value pointerTarget = 2705 builder.create<fir::BoxAddrOp>(loc, pointerBoxProc); 2706 if (isStaticallyAbsent(args[1])) 2707 return builder.genIsNotNullAddr(loc, pointerTarget); 2708 mlir::Value target = fir::getBase(args[1]); 2709 if (fir::isBoxProcAddressType(target.getType())) 2710 target = builder.create<fir::LoadOp>(loc, target); 2711 if (mlir::isa<fir::BoxProcType>(target.getType())) 2712 target = builder.create<fir::BoxAddrOp>(loc, target); 2713 mlir::Type intPtrTy = builder.getIntPtrType(); 2714 mlir::Value pointerInt = 2715 builder.createConvert(loc, intPtrTy, pointerTarget); 2716 mlir::Value targetInt = builder.createConvert(loc, intPtrTy, target); 2717 mlir::Value sameTarget = builder.create<mlir::arith::CmpIOp>( 2718 loc, mlir::arith::CmpIPredicate::eq, pointerInt, targetInt); 2719 mlir::Value zero = builder.createIntegerConstant(loc, intPtrTy, 0); 2720 mlir::Value notNull = builder.create<mlir::arith::CmpIOp>( 2721 loc, mlir::arith::CmpIPredicate::ne, zero, pointerInt); 2722 // The not notNull test covers the following two cases: 2723 // - TARGET is a procedure that is OPTIONAL and absent at runtime. 2724 // - TARGET is a procedure pointer that is NULL. 2725 // In both cases, ASSOCIATED should be false if POINTER is NULL. 2726 return builder.create<mlir::arith::AndIOp>(loc, sameTarget, notNull); 2727 } 2728 auto *pointer = 2729 args[0].match([&](const fir::MutableBoxValue &x) { return &x; }, 2730 [&](const auto &) -> const fir::MutableBoxValue * { 2731 fir::emitFatalError(loc, "pointer not a MutableBoxValue"); 2732 }); 2733 const fir::ExtendedValue &target = args[1]; 2734 if (isStaticallyAbsent(target)) 2735 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer); 2736 mlir::Value targetBox = builder.createBox(loc, target); 2737 mlir::Value pointerBoxRef = 2738 fir::factory::getMutableIRBox(builder, loc, *pointer); 2739 auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef); 2740 return fir::runtime::genAssociated(builder, loc, pointerBox, targetBox); 2741 } 2742 2743 // BESSEL_JN 2744 fir::ExtendedValue 2745 IntrinsicLibrary::genBesselJn(mlir::Type resultType, 2746 llvm::ArrayRef<fir::ExtendedValue> args) { 2747 assert(args.size() == 2 || args.size() == 3); 2748 2749 mlir::Value x = fir::getBase(args.back()); 2750 2751 if (args.size() == 2) { 2752 mlir::Value n = fir::getBase(args[0]); 2753 2754 return genRuntimeCall("bessel_jn", resultType, {n, x}); 2755 } else { 2756 mlir::Value n1 = fir::getBase(args[0]); 2757 mlir::Value n2 = fir::getBase(args[1]); 2758 2759 mlir::Type intTy = n1.getType(); 2760 mlir::Type floatTy = x.getType(); 2761 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy); 2762 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1); 2763 2764 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1); 2765 fir::MutableBoxValue resultMutableBox = 2766 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 2767 mlir::Value resultBox = 2768 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 2769 2770 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>( 2771 loc, mlir::arith::CmpFPredicate::UEQ, x, zero); 2772 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>( 2773 loc, mlir::arith::CmpIPredicate::slt, n1, n2); 2774 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>( 2775 loc, mlir::arith::CmpIPredicate::eq, n1, n2); 2776 2777 auto genXEq0 = [&]() { 2778 fir::runtime::genBesselJnX0(builder, loc, floatTy, resultBox, n1, n2); 2779 }; 2780 2781 auto genN1LtN2 = [&]() { 2782 // The runtime generates the values in the range using a backward 2783 // recursion from n2 to n1. (see https://dlmf.nist.gov/10.74.iv and 2784 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires 2785 // the values of BESSEL_JN(n2) and BESSEL_JN(n2 - 1) since they 2786 // are the anchors of the recursion. 2787 mlir::Value n2_1 = builder.create<mlir::arith::SubIOp>(loc, n2, one); 2788 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x}); 2789 mlir::Value bn2_1 = genRuntimeCall("bessel_jn", resultType, {n2_1, x}); 2790 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, bn2_1); 2791 }; 2792 2793 auto genN1EqN2 = [&]() { 2794 // When n1 == n2, only BESSEL_JN(n2) is needed. 2795 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x}); 2796 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, zero); 2797 }; 2798 2799 auto genN1GtN2 = [&]() { 2800 // The standard requires n1 <= n2. However, we still need to allocate 2801 // a zero-length array and return it when n1 > n2, so we do need to call 2802 // the runtime function. 2803 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, zero, zero); 2804 }; 2805 2806 auto genN1GeN2 = [&] { 2807 builder.genIfThenElse(loc, cmpN1EqN2) 2808 .genThen(genN1EqN2) 2809 .genElse(genN1GtN2) 2810 .end(); 2811 }; 2812 2813 auto genXNeq0 = [&]() { 2814 builder.genIfThenElse(loc, cmpN1LtN2) 2815 .genThen(genN1LtN2) 2816 .genElse(genN1GeN2) 2817 .end(); 2818 }; 2819 2820 builder.genIfThenElse(loc, cmpXEq0) 2821 .genThen(genXEq0) 2822 .genElse(genXNeq0) 2823 .end(); 2824 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_JN"); 2825 } 2826 } 2827 2828 // BESSEL_YN 2829 fir::ExtendedValue 2830 IntrinsicLibrary::genBesselYn(mlir::Type resultType, 2831 llvm::ArrayRef<fir::ExtendedValue> args) { 2832 assert(args.size() == 2 || args.size() == 3); 2833 2834 mlir::Value x = fir::getBase(args.back()); 2835 2836 if (args.size() == 2) { 2837 mlir::Value n = fir::getBase(args[0]); 2838 2839 return genRuntimeCall("bessel_yn", resultType, {n, x}); 2840 } else { 2841 mlir::Value n1 = fir::getBase(args[0]); 2842 mlir::Value n2 = fir::getBase(args[1]); 2843 2844 mlir::Type floatTy = x.getType(); 2845 mlir::Type intTy = n1.getType(); 2846 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy); 2847 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1); 2848 2849 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1); 2850 fir::MutableBoxValue resultMutableBox = 2851 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 2852 mlir::Value resultBox = 2853 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 2854 2855 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>( 2856 loc, mlir::arith::CmpFPredicate::UEQ, x, zero); 2857 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>( 2858 loc, mlir::arith::CmpIPredicate::slt, n1, n2); 2859 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>( 2860 loc, mlir::arith::CmpIPredicate::eq, n1, n2); 2861 2862 auto genXEq0 = [&]() { 2863 fir::runtime::genBesselYnX0(builder, loc, floatTy, resultBox, n1, n2); 2864 }; 2865 2866 auto genN1LtN2 = [&]() { 2867 // The runtime generates the values in the range using a forward 2868 // recursion from n1 to n2. (see https://dlmf.nist.gov/10.74.iv and 2869 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires 2870 // the values of BESSEL_YN(n1) and BESSEL_YN(n1 + 1) since they 2871 // are the anchors of the recursion. 2872 mlir::Value n1_1 = builder.create<mlir::arith::AddIOp>(loc, n1, one); 2873 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x}); 2874 mlir::Value bn1_1 = genRuntimeCall("bessel_yn", resultType, {n1_1, x}); 2875 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, bn1_1); 2876 }; 2877 2878 auto genN1EqN2 = [&]() { 2879 // When n1 == n2, only BESSEL_YN(n1) is needed. 2880 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x}); 2881 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, zero); 2882 }; 2883 2884 auto genN1GtN2 = [&]() { 2885 // The standard requires n1 <= n2. However, we still need to allocate 2886 // a zero-length array and return it when n1 > n2, so we do need to call 2887 // the runtime function. 2888 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, zero, zero); 2889 }; 2890 2891 auto genN1GeN2 = [&] { 2892 builder.genIfThenElse(loc, cmpN1EqN2) 2893 .genThen(genN1EqN2) 2894 .genElse(genN1GtN2) 2895 .end(); 2896 }; 2897 2898 auto genXNeq0 = [&]() { 2899 builder.genIfThenElse(loc, cmpN1LtN2) 2900 .genThen(genN1LtN2) 2901 .genElse(genN1GeN2) 2902 .end(); 2903 }; 2904 2905 builder.genIfThenElse(loc, cmpXEq0) 2906 .genThen(genXEq0) 2907 .genElse(genXNeq0) 2908 .end(); 2909 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_YN"); 2910 } 2911 } 2912 2913 // BGE, BGT, BLE, BLT 2914 template <mlir::arith::CmpIPredicate pred> 2915 mlir::Value 2916 IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType, 2917 llvm::ArrayRef<mlir::Value> args) { 2918 assert(args.size() == 2); 2919 2920 mlir::Value arg0 = args[0]; 2921 mlir::Value arg1 = args[1]; 2922 mlir::Type arg0Ty = arg0.getType(); 2923 mlir::Type arg1Ty = arg1.getType(); 2924 int bits0 = arg0Ty.getIntOrFloatBitWidth(); 2925 int bits1 = arg1Ty.getIntOrFloatBitWidth(); 2926 2927 // Arguments do not have to be of the same integer type. However, if neither 2928 // of the arguments is a BOZ literal, then the shorter of the two needs 2929 // to be converted to the longer by zero-extending (not sign-extending) 2930 // to the left [Fortran 2008, 13.3.2]. 2931 // 2932 // In the case of BOZ literals, the standard describes zero-extension or 2933 // truncation depending on the kind of the result [Fortran 2008, 13.3.3]. 2934 // However, that seems to be relevant for the case where the type of the 2935 // result must match the type of the BOZ literal. That is not the case for 2936 // these intrinsics, so, again, zero-extend to the larger type. 2937 int widest = bits0 > bits1 ? bits0 : bits1; 2938 mlir::Type signlessType = 2939 mlir::IntegerType::get(builder.getContext(), widest, 2940 mlir::IntegerType::SignednessSemantics::Signless); 2941 if (arg0Ty.isUnsignedInteger()) 2942 arg0 = builder.createConvert(loc, signlessType, arg0); 2943 else if (bits0 < widest) 2944 arg0 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg0); 2945 if (arg1Ty.isUnsignedInteger()) 2946 arg1 = builder.createConvert(loc, signlessType, arg1); 2947 else if (bits1 < widest) 2948 arg1 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg1); 2949 return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1); 2950 } 2951 2952 // BTEST 2953 mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType, 2954 llvm::ArrayRef<mlir::Value> args) { 2955 // A conformant BTEST(I,POS) call satisfies: 2956 // POS >= 0 2957 // POS < BIT_SIZE(I) 2958 // Return: (I >> POS) & 1 2959 assert(args.size() == 2); 2960 mlir::Value word = args[0]; 2961 mlir::Type signlessType = mlir::IntegerType::get( 2962 builder.getContext(), word.getType().getIntOrFloatBitWidth(), 2963 mlir::IntegerType::SignednessSemantics::Signless); 2964 if (word.getType().isUnsignedInteger()) 2965 word = builder.createConvert(loc, signlessType, word); 2966 mlir::Value shiftCount = builder.createConvert(loc, signlessType, args[1]); 2967 mlir::Value shifted = 2968 builder.create<mlir::arith::ShRUIOp>(loc, word, shiftCount); 2969 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1); 2970 mlir::Value bit = builder.create<mlir::arith::AndIOp>(loc, shifted, one); 2971 return builder.createConvert(loc, resultType, bit); 2972 } 2973 2974 static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder, 2975 mlir::Location loc, fir::ExtendedValue arg, 2976 bool isFunc) { 2977 mlir::Value argValue = fir::getBase(arg); 2978 mlir::Value addr{nullptr}; 2979 if (isFunc) { 2980 auto funcTy = mlir::cast<fir::BoxProcType>(argValue.getType()).getEleTy(); 2981 addr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue); 2982 } else { 2983 const auto *box = arg.getBoxOf<fir::BoxValue>(); 2984 addr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), 2985 fir::getBase(*box)); 2986 } 2987 return addr; 2988 } 2989 2990 static fir::ExtendedValue 2991 genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc, 2992 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args, 2993 bool isFunc = false, bool isDevLoc = false) { 2994 assert(args.size() == 1); 2995 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType); 2996 mlir::Value resAddr; 2997 if (isDevLoc) 2998 resAddr = fir::factory::genCDevPtrAddr(builder, loc, res, resultType); 2999 else 3000 resAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType); 3001 assert(fir::isa_box_type(fir::getBase(args[0]).getType()) && 3002 "argument must have been lowered to box type"); 3003 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc); 3004 mlir::Value argAddrVal = builder.createConvert( 3005 loc, fir::unwrapRefType(resAddr.getType()), argAddr); 3006 builder.create<fir::StoreOp>(loc, argAddrVal, resAddr); 3007 return res; 3008 } 3009 3010 /// C_ASSOCIATED 3011 static fir::ExtendedValue 3012 genCAssociated(fir::FirOpBuilder &builder, mlir::Location loc, 3013 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) { 3014 assert(args.size() == 2); 3015 mlir::Value cPtr1 = fir::getBase(args[0]); 3016 mlir::Value cPtrVal1 = 3017 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1); 3018 mlir::Value zero = builder.createIntegerConstant(loc, cPtrVal1.getType(), 0); 3019 mlir::Value res = builder.create<mlir::arith::CmpIOp>( 3020 loc, mlir::arith::CmpIPredicate::ne, cPtrVal1, zero); 3021 3022 if (isStaticallyPresent(args[1])) { 3023 mlir::Type i1Ty = builder.getI1Type(); 3024 mlir::Value cPtr2 = fir::getBase(args[1]); 3025 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, cPtr2); 3026 res = 3027 builder 3028 .genIfOp(loc, {i1Ty}, isDynamicallyAbsent, /*withElseRegion=*/true) 3029 .genThen([&]() { builder.create<fir::ResultOp>(loc, res); }) 3030 .genElse([&]() { 3031 mlir::Value cPtrVal2 = 3032 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2); 3033 mlir::Value cmpVal = builder.create<mlir::arith::CmpIOp>( 3034 loc, mlir::arith::CmpIPredicate::eq, cPtrVal1, cPtrVal2); 3035 mlir::Value newRes = 3036 builder.create<mlir::arith::AndIOp>(loc, res, cmpVal); 3037 builder.create<fir::ResultOp>(loc, newRes); 3038 }) 3039 .getResults()[0]; 3040 } 3041 return builder.createConvert(loc, resultType, res); 3042 } 3043 3044 /// C_ASSOCIATED (C_FUNPTR [, C_FUNPTR]) 3045 fir::ExtendedValue IntrinsicLibrary::genCAssociatedCFunPtr( 3046 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) { 3047 return genCAssociated(builder, loc, resultType, args); 3048 } 3049 3050 /// C_ASSOCIATED (C_PTR [, C_PTR]) 3051 fir::ExtendedValue 3052 IntrinsicLibrary::genCAssociatedCPtr(mlir::Type resultType, 3053 llvm::ArrayRef<fir::ExtendedValue> args) { 3054 return genCAssociated(builder, loc, resultType, args); 3055 } 3056 3057 // C_DEVLOC 3058 fir::ExtendedValue 3059 IntrinsicLibrary::genCDevLoc(mlir::Type resultType, 3060 llvm::ArrayRef<fir::ExtendedValue> args) { 3061 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/false, 3062 /*isDevLoc=*/true); 3063 } 3064 3065 // C_F_POINTER 3066 void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) { 3067 assert(args.size() == 3); 3068 // Handle CPTR argument 3069 // Get the value of the C address or the result of a reference to C_LOC. 3070 mlir::Value cPtr = fir::getBase(args[0]); 3071 mlir::Value cPtrAddrVal = 3072 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr); 3073 3074 // Handle FPTR argument 3075 const auto *fPtr = args[1].getBoxOf<fir::MutableBoxValue>(); 3076 assert(fPtr && "FPTR must be a pointer"); 3077 3078 auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue { 3079 mlir::Value addr = 3080 builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal); 3081 mlir::SmallVector<mlir::Value> extents; 3082 if (box.hasRank()) { 3083 assert(isStaticallyPresent(args[2]) && 3084 "FPTR argument must be an array if SHAPE argument exists"); 3085 mlir::Value shape = fir::getBase(args[2]); 3086 int arrayRank = box.rank(); 3087 mlir::Type shapeElementType = 3088 fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType())); 3089 mlir::Type idxType = builder.getIndexType(); 3090 for (int i = 0; i < arrayRank; ++i) { 3091 mlir::Value index = builder.createIntegerConstant(loc, idxType, i); 3092 mlir::Value var = builder.create<fir::CoordinateOp>( 3093 loc, builder.getRefType(shapeElementType), shape, index); 3094 mlir::Value load = builder.create<fir::LoadOp>(loc, var); 3095 extents.push_back(builder.createConvert(loc, idxType, load)); 3096 } 3097 } 3098 if (box.isCharacter()) { 3099 mlir::Value len = box.nonDeferredLenParams()[0]; 3100 if (box.hasRank()) 3101 return fir::CharArrayBoxValue{addr, len, extents}; 3102 return fir::CharBoxValue{addr, len}; 3103 } 3104 if (box.isDerivedWithLenParameters()) 3105 TODO(loc, "get length parameters of derived type"); 3106 if (box.hasRank()) 3107 return fir::ArrayBoxValue{addr, extents}; 3108 return addr; 3109 }; 3110 3111 fir::factory::associateMutableBox(builder, loc, *fPtr, getCPtrExtVal(*fPtr), 3112 /*lbounds=*/mlir::ValueRange{}); 3113 } 3114 3115 // C_F_PROCPOINTER 3116 void IntrinsicLibrary::genCFProcPointer( 3117 llvm::ArrayRef<fir::ExtendedValue> args) { 3118 assert(args.size() == 2); 3119 mlir::Value cptr = 3120 fir::factory::genCPtrOrCFunptrValue(builder, loc, fir::getBase(args[0])); 3121 mlir::Value fptr = fir::getBase(args[1]); 3122 auto boxProcType = 3123 mlir::cast<fir::BoxProcType>(fir::unwrapRefType(fptr.getType())); 3124 mlir::Value cptrCast = 3125 builder.createConvert(loc, boxProcType.getEleTy(), cptr); 3126 mlir::Value cptrBox = 3127 builder.create<fir::EmboxProcOp>(loc, boxProcType, cptrCast); 3128 builder.create<fir::StoreOp>(loc, cptrBox, fptr); 3129 } 3130 3131 // C_FUNLOC 3132 fir::ExtendedValue 3133 IntrinsicLibrary::genCFunLoc(mlir::Type resultType, 3134 llvm::ArrayRef<fir::ExtendedValue> args) { 3135 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true); 3136 } 3137 3138 // C_LOC 3139 fir::ExtendedValue 3140 IntrinsicLibrary::genCLoc(mlir::Type resultType, 3141 llvm::ArrayRef<fir::ExtendedValue> args) { 3142 return genCLocOrCFunLoc(builder, loc, resultType, args); 3143 } 3144 3145 // C_PTR_EQ and C_PTR_NE 3146 template <mlir::arith::CmpIPredicate pred> 3147 fir::ExtendedValue 3148 IntrinsicLibrary::genCPtrCompare(mlir::Type resultType, 3149 llvm::ArrayRef<fir::ExtendedValue> args) { 3150 assert(args.size() == 2); 3151 mlir::Value cPtr1 = fir::getBase(args[0]); 3152 mlir::Value cPtrVal1 = 3153 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1); 3154 mlir::Value cPtr2 = fir::getBase(args[1]); 3155 mlir::Value cPtrVal2 = 3156 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2); 3157 mlir::Value cmp = 3158 builder.create<mlir::arith::CmpIOp>(loc, pred, cPtrVal1, cPtrVal2); 3159 return builder.createConvert(loc, resultType, cmp); 3160 } 3161 3162 // CEILING 3163 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, 3164 llvm::ArrayRef<mlir::Value> args) { 3165 // Optional KIND argument. 3166 assert(args.size() >= 1); 3167 mlir::Value arg = args[0]; 3168 // Use ceil that is not an actual Fortran intrinsic but that is 3169 // an llvm intrinsic that does the same, but return a floating 3170 // point. 3171 mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg}); 3172 return builder.createConvert(loc, resultType, ceil); 3173 } 3174 3175 // CHAR 3176 fir::ExtendedValue 3177 IntrinsicLibrary::genChar(mlir::Type type, 3178 llvm::ArrayRef<fir::ExtendedValue> args) { 3179 // Optional KIND argument. 3180 assert(args.size() >= 1); 3181 const mlir::Value *arg = args[0].getUnboxed(); 3182 // expect argument to be a scalar integer 3183 if (!arg) 3184 mlir::emitError(loc, "CHAR intrinsic argument not unboxed"); 3185 fir::factory::CharacterExprHelper helper{builder, loc}; 3186 fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind(); 3187 mlir::Value cast = helper.createSingletonFromCode(*arg, kind); 3188 mlir::Value len = 3189 builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1); 3190 return fir::CharBoxValue{cast, len}; 3191 } 3192 3193 // CHDIR 3194 fir::ExtendedValue 3195 IntrinsicLibrary::genChdir(std::optional<mlir::Type> resultType, 3196 llvm::ArrayRef<fir::ExtendedValue> args) { 3197 assert((args.size() == 1 && resultType.has_value()) || 3198 (args.size() >= 1 && !resultType.has_value())); 3199 mlir::Value name = fir::getBase(args[0]); 3200 mlir::Value status = fir::runtime::genChdir(builder, loc, name); 3201 3202 if (resultType.has_value()) { 3203 return status; 3204 } else { 3205 // Subroutine form, store status and return none. 3206 if (!isStaticallyAbsent(args[1])) { 3207 mlir::Value statusAddr = fir::getBase(args[1]); 3208 statusAddr.dump(); 3209 mlir::Value statusIsPresentAtRuntime = 3210 builder.genIsNotNullAddr(loc, statusAddr); 3211 builder.genIfThen(loc, statusIsPresentAtRuntime) 3212 .genThen([&]() { 3213 builder.createStoreWithConvert(loc, status, statusAddr); 3214 }) 3215 .end(); 3216 } 3217 } 3218 3219 return {}; 3220 } 3221 3222 // CMPLX 3223 mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType, 3224 llvm::ArrayRef<mlir::Value> args) { 3225 assert(args.size() >= 1); 3226 fir::factory::Complex complexHelper(builder, loc); 3227 mlir::Type partType = complexHelper.getComplexPartType(resultType); 3228 mlir::Value real = builder.createConvert(loc, partType, args[0]); 3229 mlir::Value imag = isStaticallyAbsent(args, 1) 3230 ? builder.createRealZeroConstant(loc, partType) 3231 : builder.createConvert(loc, partType, args[1]); 3232 return fir::factory::Complex{builder, loc}.createComplex(resultType, real, 3233 imag); 3234 } 3235 3236 // COMMAND_ARGUMENT_COUNT 3237 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount( 3238 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) { 3239 assert(args.size() == 0); 3240 assert(resultType == builder.getDefaultIntegerType() && 3241 "result type is not default integer kind type"); 3242 return builder.createConvert( 3243 loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc)); 3244 ; 3245 } 3246 3247 // CONJG 3248 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, 3249 llvm::ArrayRef<mlir::Value> args) { 3250 assert(args.size() == 1); 3251 if (resultType != args[0].getType()) 3252 llvm_unreachable("argument type mismatch"); 3253 3254 mlir::Value cplx = args[0]; 3255 auto imag = fir::factory::Complex{builder, loc}.extractComplexPart( 3256 cplx, /*isImagPart=*/true); 3257 auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag); 3258 return fir::factory::Complex{builder, loc}.insertComplexPart( 3259 cplx, negImag, /*isImagPart=*/true); 3260 } 3261 3262 // COSD 3263 mlir::Value IntrinsicLibrary::genCosd(mlir::Type resultType, 3264 llvm::ArrayRef<mlir::Value> args) { 3265 assert(args.size() == 1); 3266 mlir::MLIRContext *context = builder.getContext(); 3267 mlir::FunctionType ftype = 3268 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 3269 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 3270 mlir::Value dfactor = builder.createRealConstant( 3271 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0)); 3272 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor); 3273 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor); 3274 return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg}); 3275 } 3276 3277 // COUNT 3278 fir::ExtendedValue 3279 IntrinsicLibrary::genCount(mlir::Type resultType, 3280 llvm::ArrayRef<fir::ExtendedValue> args) { 3281 assert(args.size() == 3); 3282 3283 // Handle mask argument 3284 fir::BoxValue mask = builder.createBox(loc, args[0]); 3285 unsigned maskRank = mask.rank(); 3286 3287 assert(maskRank > 0); 3288 3289 // Handle optional dim argument 3290 bool absentDim = isStaticallyAbsent(args[1]); 3291 mlir::Value dim = 3292 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0) 3293 : fir::getBase(args[1]); 3294 3295 if (absentDim || maskRank == 1) { 3296 // Result is scalar if no dim argument or mask is rank 1. 3297 // So, call specialized Count runtime routine. 3298 return builder.createConvert( 3299 loc, resultType, 3300 fir::runtime::genCount(builder, loc, fir::getBase(mask), dim)); 3301 } 3302 3303 // Call general CountDim runtime routine. 3304 3305 // Handle optional kind argument 3306 bool absentKind = isStaticallyAbsent(args[2]); 3307 mlir::Value kind = absentKind ? builder.createIntegerConstant( 3308 loc, builder.getIndexType(), 3309 builder.getKindMap().defaultIntegerKind()) 3310 : fir::getBase(args[2]); 3311 3312 // Create mutable fir.box to be passed to the runtime for the result. 3313 mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1); 3314 fir::MutableBoxValue resultMutableBox = 3315 fir::factory::createTempMutableBox(builder, loc, type); 3316 3317 mlir::Value resultIrBox = 3318 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 3319 3320 fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim, 3321 kind); 3322 // Handle cleanup of allocatable result descriptor and return 3323 return readAndAddCleanUp(resultMutableBox, resultType, "COUNT"); 3324 } 3325 3326 // CPU_TIME 3327 void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) { 3328 assert(args.size() == 1); 3329 const mlir::Value *arg = args[0].getUnboxed(); 3330 assert(arg && "nonscalar cpu_time argument"); 3331 mlir::Value res1 = fir::runtime::genCpuTime(builder, loc); 3332 mlir::Value res2 = 3333 builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1); 3334 builder.create<fir::StoreOp>(loc, res2, *arg); 3335 } 3336 3337 // CSHIFT 3338 fir::ExtendedValue 3339 IntrinsicLibrary::genCshift(mlir::Type resultType, 3340 llvm::ArrayRef<fir::ExtendedValue> args) { 3341 assert(args.size() == 3); 3342 3343 // Handle required ARRAY argument 3344 fir::BoxValue arrayBox = builder.createBox(loc, args[0]); 3345 mlir::Value array = fir::getBase(arrayBox); 3346 unsigned arrayRank = arrayBox.rank(); 3347 3348 // Create mutable fir.box to be passed to the runtime for the result. 3349 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank); 3350 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 3351 builder, loc, resultArrayType, {}, 3352 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{}); 3353 mlir::Value resultIrBox = 3354 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 3355 3356 if (arrayRank == 1) { 3357 // Vector case 3358 // Handle required SHIFT argument as a scalar 3359 const mlir::Value *shiftAddr = args[1].getUnboxed(); 3360 assert(shiftAddr && "nonscalar CSHIFT argument"); 3361 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr); 3362 3363 fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift); 3364 } else { 3365 // Non-vector case 3366 // Handle required SHIFT argument as an array 3367 mlir::Value shift = builder.createBox(loc, args[1]); 3368 3369 // Handle optional DIM argument 3370 mlir::Value dim = 3371 isStaticallyAbsent(args[2]) 3372 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) 3373 : fir::getBase(args[2]); 3374 fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim); 3375 } 3376 return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT"); 3377 } 3378 3379 // DATE_AND_TIME 3380 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) { 3381 assert(args.size() == 4 && "date_and_time has 4 args"); 3382 llvm::SmallVector<std::optional<fir::CharBoxValue>> charArgs(3); 3383 for (unsigned i = 0; i < 3; ++i) 3384 if (const fir::CharBoxValue *charBox = args[i].getCharBox()) 3385 charArgs[i] = *charBox; 3386 3387 mlir::Value values = fir::getBase(args[3]); 3388 if (!values) 3389 values = builder.create<fir::AbsentOp>( 3390 loc, fir::BoxType::get(builder.getNoneType())); 3391 3392 fir::runtime::genDateAndTime(builder, loc, charArgs[0], charArgs[1], 3393 charArgs[2], values); 3394 } 3395 3396 // DIM 3397 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType, 3398 llvm::ArrayRef<mlir::Value> args) { 3399 assert(args.size() == 2); 3400 if (mlir::isa<mlir::IntegerType>(resultType)) { 3401 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0); 3402 auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]); 3403 auto cmp = builder.create<mlir::arith::CmpIOp>( 3404 loc, mlir::arith::CmpIPredicate::sgt, diff, zero); 3405 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero); 3406 } 3407 assert(fir::isa_real(resultType) && "Only expects real and integer in DIM"); 3408 mlir::Value zero = builder.createRealZeroConstant(loc, resultType); 3409 auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]); 3410 auto cmp = builder.create<mlir::arith::CmpFOp>( 3411 loc, mlir::arith::CmpFPredicate::OGT, diff, zero); 3412 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero); 3413 } 3414 3415 // DOT_PRODUCT 3416 fir::ExtendedValue 3417 IntrinsicLibrary::genDotProduct(mlir::Type resultType, 3418 llvm::ArrayRef<fir::ExtendedValue> args) { 3419 assert(args.size() == 2); 3420 3421 // Handle required vector arguments 3422 mlir::Value vectorA = fir::getBase(args[0]); 3423 mlir::Value vectorB = fir::getBase(args[1]); 3424 // Result type is used for picking appropriate runtime function. 3425 mlir::Type eleTy = resultType; 3426 3427 if (fir::isa_complex(eleTy)) { 3428 mlir::Value result = builder.createTemporary(loc, eleTy); 3429 fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, result); 3430 return builder.create<fir::LoadOp>(loc, result); 3431 } 3432 3433 // This operation is only used to pass the result type 3434 // information to the DotProduct generator. 3435 auto resultBox = builder.create<fir::AbsentOp>(loc, fir::BoxType::get(eleTy)); 3436 return fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, resultBox); 3437 } 3438 3439 // DPROD 3440 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType, 3441 llvm::ArrayRef<mlir::Value> args) { 3442 assert(args.size() == 2); 3443 assert(fir::isa_real(resultType) && 3444 "Result must be double precision in DPROD"); 3445 mlir::Value a = builder.createConvert(loc, resultType, args[0]); 3446 mlir::Value b = builder.createConvert(loc, resultType, args[1]); 3447 return builder.create<mlir::arith::MulFOp>(loc, a, b); 3448 } 3449 3450 // DSHIFTL 3451 mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType, 3452 llvm::ArrayRef<mlir::Value> args) { 3453 assert(args.size() == 3); 3454 3455 mlir::Value i = args[0]; 3456 mlir::Value j = args[1]; 3457 int bits = resultType.getIntOrFloatBitWidth(); 3458 mlir::Type signlessType = 3459 mlir::IntegerType::get(builder.getContext(), bits, 3460 mlir::IntegerType::SignednessSemantics::Signless); 3461 if (resultType.isUnsignedInteger()) { 3462 i = builder.createConvert(loc, signlessType, i); 3463 j = builder.createConvert(loc, signlessType, j); 3464 } 3465 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]); 3466 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits); 3467 3468 // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to 3469 // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT)) 3470 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift); 3471 3472 mlir::Value lArgs[2]{i, shift}; 3473 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs); 3474 3475 mlir::Value rArgs[2]{j, diff}; 3476 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs); 3477 mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt); 3478 if (resultType.isUnsignedInteger()) 3479 return builder.createConvert(loc, resultType, result); 3480 return result; 3481 } 3482 3483 // DSHIFTR 3484 mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType, 3485 llvm::ArrayRef<mlir::Value> args) { 3486 assert(args.size() == 3); 3487 3488 mlir::Value i = args[0]; 3489 mlir::Value j = args[1]; 3490 int bits = resultType.getIntOrFloatBitWidth(); 3491 mlir::Type signlessType = 3492 mlir::IntegerType::get(builder.getContext(), bits, 3493 mlir::IntegerType::SignednessSemantics::Signless); 3494 if (resultType.isUnsignedInteger()) { 3495 i = builder.createConvert(loc, signlessType, i); 3496 j = builder.createConvert(loc, signlessType, j); 3497 } 3498 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]); 3499 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits); 3500 3501 // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to 3502 // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT)) 3503 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift); 3504 3505 mlir::Value lArgs[2]{i, diff}; 3506 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs); 3507 3508 mlir::Value rArgs[2]{j, shift}; 3509 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs); 3510 mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt); 3511 if (resultType.isUnsignedInteger()) 3512 return builder.createConvert(loc, resultType, result); 3513 return result; 3514 } 3515 3516 // EOSHIFT 3517 fir::ExtendedValue 3518 IntrinsicLibrary::genEoshift(mlir::Type resultType, 3519 llvm::ArrayRef<fir::ExtendedValue> args) { 3520 assert(args.size() == 4); 3521 3522 // Handle required ARRAY argument 3523 fir::BoxValue arrayBox = builder.createBox(loc, args[0]); 3524 mlir::Value array = fir::getBase(arrayBox); 3525 unsigned arrayRank = arrayBox.rank(); 3526 3527 // Create mutable fir.box to be passed to the runtime for the result. 3528 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank); 3529 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 3530 builder, loc, resultArrayType, {}, 3531 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{}); 3532 mlir::Value resultIrBox = 3533 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 3534 3535 // Handle optional BOUNDARY argument 3536 mlir::Value boundary = 3537 isStaticallyAbsent(args[2]) 3538 ? builder.create<fir::AbsentOp>( 3539 loc, fir::BoxType::get(builder.getNoneType())) 3540 : builder.createBox(loc, args[2]); 3541 3542 if (arrayRank == 1) { 3543 // Vector case 3544 // Handle required SHIFT argument as a scalar 3545 const mlir::Value *shiftAddr = args[1].getUnboxed(); 3546 assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument"); 3547 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr); 3548 fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift, 3549 boundary); 3550 } else { 3551 // Non-vector case 3552 // Handle required SHIFT argument as an array 3553 mlir::Value shift = builder.createBox(loc, args[1]); 3554 3555 // Handle optional DIM argument 3556 mlir::Value dim = 3557 isStaticallyAbsent(args[3]) 3558 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) 3559 : fir::getBase(args[3]); 3560 fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary, 3561 dim); 3562 } 3563 return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT"); 3564 } 3565 3566 // EXECUTE_COMMAND_LINE 3567 void IntrinsicLibrary::genExecuteCommandLine( 3568 llvm::ArrayRef<fir::ExtendedValue> args) { 3569 assert(args.size() == 5); 3570 3571 mlir::Value command = fir::getBase(args[0]); 3572 // Optional arguments: wait, exitstat, cmdstat, cmdmsg. 3573 const fir::ExtendedValue &wait = args[1]; 3574 const fir::ExtendedValue &exitstat = args[2]; 3575 const fir::ExtendedValue &cmdstat = args[3]; 3576 const fir::ExtendedValue &cmdmsg = args[4]; 3577 3578 if (!command) 3579 fir::emitFatalError(loc, "expected COMMAND parameter"); 3580 3581 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 3582 3583 mlir::Value waitBool; 3584 if (isStaticallyAbsent(wait)) { 3585 waitBool = builder.createBool(loc, true); 3586 } else { 3587 mlir::Type i1Ty = builder.getI1Type(); 3588 mlir::Value waitAddr = fir::getBase(wait); 3589 mlir::Value waitIsPresentAtRuntime = 3590 builder.genIsNotNullAddr(loc, waitAddr); 3591 waitBool = builder 3592 .genIfOp(loc, {i1Ty}, waitIsPresentAtRuntime, 3593 /*withElseRegion=*/true) 3594 .genThen([&]() { 3595 auto waitLoad = builder.create<fir::LoadOp>(loc, waitAddr); 3596 mlir::Value cast = 3597 builder.createConvert(loc, i1Ty, waitLoad); 3598 builder.create<fir::ResultOp>(loc, cast); 3599 }) 3600 .genElse([&]() { 3601 mlir::Value trueVal = builder.createBool(loc, true); 3602 builder.create<fir::ResultOp>(loc, trueVal); 3603 }) 3604 .getResults()[0]; 3605 } 3606 3607 mlir::Value exitstatBox = 3608 isStaticallyPresent(exitstat) 3609 ? fir::getBase(exitstat) 3610 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3611 mlir::Value cmdstatBox = 3612 isStaticallyPresent(cmdstat) 3613 ? fir::getBase(cmdstat) 3614 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3615 mlir::Value cmdmsgBox = 3616 isStaticallyPresent(cmdmsg) 3617 ? fir::getBase(cmdmsg) 3618 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3619 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool, 3620 exitstatBox, cmdstatBox, cmdmsgBox); 3621 } 3622 3623 // ETIME 3624 fir::ExtendedValue 3625 IntrinsicLibrary::genEtime(std::optional<mlir::Type> resultType, 3626 llvm::ArrayRef<fir::ExtendedValue> args) { 3627 assert((args.size() == 2 && !resultType.has_value()) || 3628 (args.size() == 1 && resultType.has_value())); 3629 3630 mlir::Value values = fir::getBase(args[0]); 3631 if (resultType.has_value()) { 3632 // function form 3633 if (!values) 3634 fir::emitFatalError(loc, "expected VALUES parameter"); 3635 3636 auto timeAddr = builder.createTemporary(loc, *resultType); 3637 auto timeBox = builder.createBox(loc, timeAddr); 3638 fir::runtime::genEtime(builder, loc, values, timeBox); 3639 return builder.create<fir::LoadOp>(loc, timeAddr); 3640 } else { 3641 // subroutine form 3642 mlir::Value time = fir::getBase(args[1]); 3643 if (!values) 3644 fir::emitFatalError(loc, "expected VALUES parameter"); 3645 if (!time) 3646 fir::emitFatalError(loc, "expected TIME parameter"); 3647 3648 fir::runtime::genEtime(builder, loc, values, time); 3649 return {}; 3650 } 3651 return {}; 3652 } 3653 3654 // EXIT 3655 void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) { 3656 assert(args.size() == 1); 3657 3658 mlir::Value status = 3659 isStaticallyAbsent(args[0]) 3660 ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(), 3661 EXIT_SUCCESS) 3662 : fir::getBase(args[0]); 3663 3664 assert(status.getType() == builder.getDefaultIntegerType() && 3665 "STATUS parameter must be an INTEGER of default kind"); 3666 3667 fir::runtime::genExit(builder, loc, status); 3668 } 3669 3670 // EXPONENT 3671 mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType, 3672 llvm::ArrayRef<mlir::Value> args) { 3673 assert(args.size() == 1); 3674 3675 return builder.createConvert( 3676 loc, resultType, 3677 fir::runtime::genExponent(builder, loc, resultType, 3678 fir::getBase(args[0]))); 3679 } 3680 3681 // EXTENDS_TYPE_OF 3682 fir::ExtendedValue 3683 IntrinsicLibrary::genExtendsTypeOf(mlir::Type resultType, 3684 llvm::ArrayRef<fir::ExtendedValue> args) { 3685 assert(args.size() == 2); 3686 3687 return builder.createConvert( 3688 loc, resultType, 3689 fir::runtime::genExtendsTypeOf(builder, loc, fir::getBase(args[0]), 3690 fir::getBase(args[1]))); 3691 } 3692 3693 // FINDLOC 3694 fir::ExtendedValue 3695 IntrinsicLibrary::genFindloc(mlir::Type resultType, 3696 llvm::ArrayRef<fir::ExtendedValue> args) { 3697 assert(args.size() == 6); 3698 3699 // Handle required array argument 3700 mlir::Value array = builder.createBox(loc, args[0]); 3701 unsigned rank = fir::BoxValue(array).rank(); 3702 assert(rank >= 1); 3703 3704 // Handle required value argument 3705 mlir::Value val = builder.createBox(loc, args[1]); 3706 3707 // Check if dim argument is present 3708 bool absentDim = isStaticallyAbsent(args[2]); 3709 3710 // Handle optional mask argument 3711 auto mask = isStaticallyAbsent(args[3]) 3712 ? builder.create<fir::AbsentOp>( 3713 loc, fir::BoxType::get(builder.getI1Type())) 3714 : builder.createBox(loc, args[3]); 3715 3716 // Handle optional kind argument 3717 auto kind = isStaticallyAbsent(args[4]) 3718 ? builder.createIntegerConstant( 3719 loc, builder.getIndexType(), 3720 builder.getKindMap().defaultIntegerKind()) 3721 : fir::getBase(args[4]); 3722 3723 // Handle optional back argument 3724 auto back = isStaticallyAbsent(args[5]) ? builder.createBool(loc, false) 3725 : fir::getBase(args[5]); 3726 3727 if (!absentDim && rank == 1) { 3728 // If dim argument is present and the array is rank 1, then the result is 3729 // a scalar (since the the result is rank-1 or 0). 3730 // Therefore, we use a scalar result descriptor with FindlocDim(). 3731 // Create mutable fir.box to be passed to the runtime for the result. 3732 fir::MutableBoxValue resultMutableBox = 3733 fir::factory::createTempMutableBox(builder, loc, resultType); 3734 mlir::Value resultIrBox = 3735 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 3736 mlir::Value dim = fir::getBase(args[2]); 3737 3738 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim, 3739 mask, kind, back); 3740 // Handle cleanup of allocatable result descriptor and return 3741 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC"); 3742 } 3743 3744 // The result will be an array. Create mutable fir.box to be passed to the 3745 // runtime for the result. 3746 mlir::Type resultArrayType = 3747 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1); 3748 fir::MutableBoxValue resultMutableBox = 3749 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 3750 mlir::Value resultIrBox = 3751 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 3752 3753 if (absentDim) { 3754 fir::runtime::genFindloc(builder, loc, resultIrBox, array, val, mask, kind, 3755 back); 3756 } else { 3757 mlir::Value dim = fir::getBase(args[2]); 3758 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim, 3759 mask, kind, back); 3760 } 3761 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC"); 3762 } 3763 3764 // FLOOR 3765 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, 3766 llvm::ArrayRef<mlir::Value> args) { 3767 // Optional KIND argument. 3768 assert(args.size() >= 1); 3769 mlir::Value arg = args[0]; 3770 // Use LLVM floor that returns real. 3771 mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg}); 3772 return builder.createConvert(loc, resultType, floor); 3773 } 3774 3775 // FRACTION 3776 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType, 3777 llvm::ArrayRef<mlir::Value> args) { 3778 assert(args.size() == 1); 3779 3780 return builder.createConvert( 3781 loc, resultType, 3782 fir::runtime::genFraction(builder, loc, fir::getBase(args[0]))); 3783 } 3784 3785 void IntrinsicLibrary::genFree(llvm::ArrayRef<fir::ExtendedValue> args) { 3786 assert(args.size() == 1); 3787 3788 fir::runtime::genFree(builder, loc, fir::getBase(args[0])); 3789 } 3790 3791 // GETCWD 3792 fir::ExtendedValue 3793 IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType, 3794 llvm::ArrayRef<fir::ExtendedValue> args) { 3795 assert((args.size() == 1 && resultType.has_value()) || 3796 (args.size() >= 1 && !resultType.has_value())); 3797 3798 mlir::Value cwd = fir::getBase(args[0]); 3799 mlir::Value statusValue = fir::runtime::genGetCwd(builder, loc, cwd); 3800 3801 if (resultType.has_value()) { 3802 // Function form, return status. 3803 return statusValue; 3804 } else { 3805 // Subroutine form, store status and return none. 3806 const fir::ExtendedValue &status = args[1]; 3807 if (!isStaticallyAbsent(status)) { 3808 mlir::Value statusAddr = fir::getBase(status); 3809 mlir::Value statusIsPresentAtRuntime = 3810 builder.genIsNotNullAddr(loc, statusAddr); 3811 builder.genIfThen(loc, statusIsPresentAtRuntime) 3812 .genThen([&]() { 3813 builder.createStoreWithConvert(loc, statusValue, statusAddr); 3814 }) 3815 .end(); 3816 } 3817 } 3818 3819 return {}; 3820 } 3821 3822 // GET_COMMAND 3823 void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) { 3824 assert(args.size() == 4); 3825 const fir::ExtendedValue &command = args[0]; 3826 const fir::ExtendedValue &length = args[1]; 3827 const fir::ExtendedValue &status = args[2]; 3828 const fir::ExtendedValue &errmsg = args[3]; 3829 3830 // If none of the optional parameters are present, do nothing. 3831 if (!isStaticallyPresent(command) && !isStaticallyPresent(length) && 3832 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg)) 3833 return; 3834 3835 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 3836 mlir::Value commandBox = 3837 isStaticallyPresent(command) 3838 ? fir::getBase(command) 3839 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3840 mlir::Value lenBox = 3841 isStaticallyPresent(length) 3842 ? fir::getBase(length) 3843 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3844 mlir::Value errBox = 3845 isStaticallyPresent(errmsg) 3846 ? fir::getBase(errmsg) 3847 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3848 mlir::Value stat = 3849 fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox); 3850 if (isStaticallyPresent(status)) { 3851 mlir::Value statAddr = fir::getBase(status); 3852 mlir::Value statIsPresentAtRuntime = 3853 builder.genIsNotNullAddr(loc, statAddr); 3854 builder.genIfThen(loc, statIsPresentAtRuntime) 3855 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) 3856 .end(); 3857 } 3858 } 3859 3860 // GETGID 3861 mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType, 3862 llvm::ArrayRef<mlir::Value> args) { 3863 assert(args.size() == 0 && "getgid takes no input"); 3864 return builder.createConvert(loc, resultType, 3865 fir::runtime::genGetGID(builder, loc)); 3866 } 3867 3868 // GETPID 3869 mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType, 3870 llvm::ArrayRef<mlir::Value> args) { 3871 assert(args.size() == 0 && "getpid takes no input"); 3872 return builder.createConvert(loc, resultType, 3873 fir::runtime::genGetPID(builder, loc)); 3874 } 3875 3876 // GETUID 3877 mlir::Value IntrinsicLibrary::genGetUID(mlir::Type resultType, 3878 llvm::ArrayRef<mlir::Value> args) { 3879 assert(args.size() == 0 && "getgid takes no input"); 3880 return builder.createConvert(loc, resultType, 3881 fir::runtime::genGetUID(builder, loc)); 3882 } 3883 3884 // GET_COMMAND_ARGUMENT 3885 void IntrinsicLibrary::genGetCommandArgument( 3886 llvm::ArrayRef<fir::ExtendedValue> args) { 3887 assert(args.size() == 5); 3888 mlir::Value number = fir::getBase(args[0]); 3889 const fir::ExtendedValue &value = args[1]; 3890 const fir::ExtendedValue &length = args[2]; 3891 const fir::ExtendedValue &status = args[3]; 3892 const fir::ExtendedValue &errmsg = args[4]; 3893 3894 if (!number) 3895 fir::emitFatalError(loc, "expected NUMBER parameter"); 3896 3897 // If none of the optional parameters are present, do nothing. 3898 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) && 3899 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg)) 3900 return; 3901 3902 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 3903 mlir::Value valBox = 3904 isStaticallyPresent(value) 3905 ? fir::getBase(value) 3906 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3907 mlir::Value lenBox = 3908 isStaticallyPresent(length) 3909 ? fir::getBase(length) 3910 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3911 mlir::Value errBox = 3912 isStaticallyPresent(errmsg) 3913 ? fir::getBase(errmsg) 3914 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3915 mlir::Value stat = fir::runtime::genGetCommandArgument( 3916 builder, loc, number, valBox, lenBox, errBox); 3917 if (isStaticallyPresent(status)) { 3918 mlir::Value statAddr = fir::getBase(status); 3919 mlir::Value statIsPresentAtRuntime = 3920 builder.genIsNotNullAddr(loc, statAddr); 3921 builder.genIfThen(loc, statIsPresentAtRuntime) 3922 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) 3923 .end(); 3924 } 3925 } 3926 3927 // GET_ENVIRONMENT_VARIABLE 3928 void IntrinsicLibrary::genGetEnvironmentVariable( 3929 llvm::ArrayRef<fir::ExtendedValue> args) { 3930 assert(args.size() == 6); 3931 mlir::Value name = fir::getBase(args[0]); 3932 const fir::ExtendedValue &value = args[1]; 3933 const fir::ExtendedValue &length = args[2]; 3934 const fir::ExtendedValue &status = args[3]; 3935 const fir::ExtendedValue &trimName = args[4]; 3936 const fir::ExtendedValue &errmsg = args[5]; 3937 3938 if (!name) 3939 fir::emitFatalError(loc, "expected NAME parameter"); 3940 3941 // If none of the optional parameters are present, do nothing. 3942 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) && 3943 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg)) 3944 return; 3945 3946 // Handle optional TRIM_NAME argument 3947 mlir::Value trim; 3948 if (isStaticallyAbsent(trimName)) { 3949 trim = builder.createBool(loc, true); 3950 } else { 3951 mlir::Type i1Ty = builder.getI1Type(); 3952 mlir::Value trimNameAddr = fir::getBase(trimName); 3953 mlir::Value trimNameIsPresentAtRuntime = 3954 builder.genIsNotNullAddr(loc, trimNameAddr); 3955 trim = builder 3956 .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime, 3957 /*withElseRegion=*/true) 3958 .genThen([&]() { 3959 auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr); 3960 mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad); 3961 builder.create<fir::ResultOp>(loc, cast); 3962 }) 3963 .genElse([&]() { 3964 mlir::Value trueVal = builder.createBool(loc, true); 3965 builder.create<fir::ResultOp>(loc, trueVal); 3966 }) 3967 .getResults()[0]; 3968 } 3969 3970 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 3971 mlir::Value valBox = 3972 isStaticallyPresent(value) 3973 ? fir::getBase(value) 3974 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3975 mlir::Value lenBox = 3976 isStaticallyPresent(length) 3977 ? fir::getBase(length) 3978 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3979 mlir::Value errBox = 3980 isStaticallyPresent(errmsg) 3981 ? fir::getBase(errmsg) 3982 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 3983 mlir::Value stat = fir::runtime::genGetEnvVariable(builder, loc, name, valBox, 3984 lenBox, trim, errBox); 3985 if (isStaticallyPresent(status)) { 3986 mlir::Value statAddr = fir::getBase(status); 3987 mlir::Value statIsPresentAtRuntime = 3988 builder.genIsNotNullAddr(loc, statAddr); 3989 builder.genIfThen(loc, statIsPresentAtRuntime) 3990 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) 3991 .end(); 3992 } 3993 } 3994 3995 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that 3996 /// take a DIM argument. 3997 template <typename FD> 3998 static fir::MutableBoxValue 3999 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder, 4000 mlir::Location loc, mlir::Value array, fir::ExtendedValue dimArg, 4001 mlir::Value mask, int rank) { 4002 4003 // Create mutable fir.box to be passed to the runtime for the result. 4004 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 4005 fir::MutableBoxValue resultMutableBox = 4006 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 4007 mlir::Value resultIrBox = 4008 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 4009 4010 mlir::Value dim = 4011 isStaticallyAbsent(dimArg) 4012 ? builder.createIntegerConstant(loc, builder.getIndexType(), 0) 4013 : fir::getBase(dimArg); 4014 funcDim(builder, loc, resultIrBox, array, dim, mask); 4015 4016 return resultMutableBox; 4017 } 4018 4019 /// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions 4020 template <typename FN, typename FD> 4021 fir::ExtendedValue 4022 IntrinsicLibrary::genReduction(FN func, FD funcDim, llvm::StringRef errMsg, 4023 mlir::Type resultType, 4024 llvm::ArrayRef<fir::ExtendedValue> args) { 4025 4026 assert(args.size() == 3); 4027 4028 // Handle required array argument 4029 fir::BoxValue arryTmp = builder.createBox(loc, args[0]); 4030 mlir::Value array = fir::getBase(arryTmp); 4031 int rank = arryTmp.rank(); 4032 assert(rank >= 1); 4033 4034 // Handle optional mask argument 4035 auto mask = isStaticallyAbsent(args[2]) 4036 ? builder.create<fir::AbsentOp>( 4037 loc, fir::BoxType::get(builder.getI1Type())) 4038 : builder.createBox(loc, args[2]); 4039 4040 bool absentDim = isStaticallyAbsent(args[1]); 4041 4042 // We call the type specific versions because the result is scalar 4043 // in the case below. 4044 if (absentDim || rank == 1) { 4045 mlir::Type ty = array.getType(); 4046 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty); 4047 auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType(); 4048 if (fir::isa_complex(eleTy)) { 4049 mlir::Value result = builder.createTemporary(loc, eleTy); 4050 func(builder, loc, array, mask, result); 4051 return builder.create<fir::LoadOp>(loc, result); 4052 } 4053 auto resultBox = builder.create<fir::AbsentOp>( 4054 loc, fir::BoxType::get(builder.getI1Type())); 4055 return func(builder, loc, array, mask, resultBox); 4056 } 4057 // Handle Product/Sum cases that have an array result. 4058 auto resultMutableBox = 4059 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank); 4060 return readAndAddCleanUp(resultMutableBox, resultType, errMsg); 4061 } 4062 4063 // IALL 4064 fir::ExtendedValue 4065 IntrinsicLibrary::genIall(mlir::Type resultType, 4066 llvm::ArrayRef<fir::ExtendedValue> args) { 4067 return genReduction(fir::runtime::genIAll, fir::runtime::genIAllDim, "IALL", 4068 resultType, args); 4069 } 4070 4071 // IAND 4072 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, 4073 llvm::ArrayRef<mlir::Value> args) { 4074 assert(args.size() == 2); 4075 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0], 4076 args[1]); 4077 } 4078 4079 // IANY 4080 fir::ExtendedValue 4081 IntrinsicLibrary::genIany(mlir::Type resultType, 4082 llvm::ArrayRef<fir::ExtendedValue> args) { 4083 return genReduction(fir::runtime::genIAny, fir::runtime::genIAnyDim, "IANY", 4084 resultType, args); 4085 } 4086 4087 // IBCLR 4088 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType, 4089 llvm::ArrayRef<mlir::Value> args) { 4090 // A conformant IBCLR(I,POS) call satisfies: 4091 // POS >= 0 4092 // POS < BIT_SIZE(I) 4093 // Return: I & (!(1 << POS)) 4094 assert(args.size() == 2); 4095 mlir::Type signlessType = mlir::IntegerType::get( 4096 builder.getContext(), resultType.getIntOrFloatBitWidth(), 4097 mlir::IntegerType::SignednessSemantics::Signless); 4098 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1); 4099 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 4100 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]); 4101 mlir::Value bit = builder.create<mlir::arith::ShLIOp>(loc, one, pos); 4102 mlir::Value mask = builder.create<mlir::arith::XOrIOp>(loc, ones, bit); 4103 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0], 4104 mask); 4105 } 4106 4107 // IBITS 4108 mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType, 4109 llvm::ArrayRef<mlir::Value> args) { 4110 // A conformant IBITS(I,POS,LEN) call satisfies: 4111 // POS >= 0 4112 // LEN >= 0 4113 // POS + LEN <= BIT_SIZE(I) 4114 // Return: LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN)) 4115 // For a conformant call, implementing (I >> POS) with a signed or an 4116 // unsigned shift produces the same result. For a nonconformant call, 4117 // the two choices may produce different results. 4118 assert(args.size() == 3); 4119 mlir::Type signlessType = mlir::IntegerType::get( 4120 builder.getContext(), resultType.getIntOrFloatBitWidth(), 4121 mlir::IntegerType::SignednessSemantics::Signless); 4122 mlir::Value word = args[0]; 4123 if (word.getType().isUnsignedInteger()) 4124 word = builder.createConvert(loc, signlessType, word); 4125 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]); 4126 mlir::Value len = builder.createConvert(loc, signlessType, args[2]); 4127 mlir::Value bitSize = builder.createIntegerConstant( 4128 loc, signlessType, mlir::cast<mlir::IntegerType>(resultType).getWidth()); 4129 mlir::Value shiftCount = 4130 builder.create<mlir::arith::SubIOp>(loc, bitSize, len); 4131 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 4132 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 4133 mlir::Value mask = 4134 builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount); 4135 mlir::Value res1 = builder.createUnsigned<mlir::arith::ShRSIOp>( 4136 loc, signlessType, word, pos); 4137 mlir::Value res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask); 4138 mlir::Value lenIsZero = builder.create<mlir::arith::CmpIOp>( 4139 loc, mlir::arith::CmpIPredicate::eq, len, zero); 4140 mlir::Value result = 4141 builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2); 4142 if (resultType.isUnsignedInteger()) 4143 return builder.createConvert(loc, resultType, result); 4144 return result; 4145 } 4146 4147 // IBSET 4148 mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType, 4149 llvm::ArrayRef<mlir::Value> args) { 4150 // A conformant IBSET(I,POS) call satisfies: 4151 // POS >= 0 4152 // POS < BIT_SIZE(I) 4153 // Return: I | (1 << POS) 4154 assert(args.size() == 2); 4155 mlir::Type signlessType = mlir::IntegerType::get( 4156 builder.getContext(), resultType.getIntOrFloatBitWidth(), 4157 mlir::IntegerType::SignednessSemantics::Signless); 4158 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1); 4159 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]); 4160 mlir::Value mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos); 4161 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0], 4162 mask); 4163 } 4164 4165 // ICHAR 4166 fir::ExtendedValue 4167 IntrinsicLibrary::genIchar(mlir::Type resultType, 4168 llvm::ArrayRef<fir::ExtendedValue> args) { 4169 // There can be an optional kind in second argument. 4170 assert(args.size() == 2); 4171 const fir::CharBoxValue *charBox = args[0].getCharBox(); 4172 if (!charBox) 4173 llvm::report_fatal_error("expected character scalar"); 4174 4175 fir::factory::CharacterExprHelper helper{builder, loc}; 4176 mlir::Value buffer = charBox->getBuffer(); 4177 mlir::Type bufferTy = buffer.getType(); 4178 mlir::Value charVal; 4179 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(bufferTy)) { 4180 assert(charTy.singleton()); 4181 charVal = buffer; 4182 } else { 4183 // Character is in memory, cast to fir.ref<char> and load. 4184 mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy); 4185 if (!ty) 4186 llvm::report_fatal_error("expected memory type"); 4187 // The length of in the character type may be unknown. Casting 4188 // to a singleton ref is required before loading. 4189 fir::CharacterType eleType = helper.getCharacterType(ty); 4190 fir::CharacterType charType = 4191 fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1); 4192 mlir::Type toTy = builder.getRefType(charType); 4193 mlir::Value cast = builder.createConvert(loc, toTy, buffer); 4194 charVal = builder.create<fir::LoadOp>(loc, cast); 4195 } 4196 LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n"); 4197 auto code = helper.extractCodeFromSingleton(charVal); 4198 if (code.getType() == resultType) 4199 return code; 4200 return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code); 4201 } 4202 4203 // llvm floating point class intrinsic test values 4204 // 0 Signaling NaN 4205 // 1 Quiet NaN 4206 // 2 Negative infinity 4207 // 3 Negative normal 4208 // 4 Negative subnormal 4209 // 5 Negative zero 4210 // 6 Positive zero 4211 // 7 Positive subnormal 4212 // 8 Positive normal 4213 // 9 Positive infinity 4214 static constexpr int finiteTest = 0b0111111000; 4215 static constexpr int infiniteTest = 0b1000000100; 4216 static constexpr int nanTest = 0b0000000011; 4217 static constexpr int negativeTest = 0b0000111100; 4218 static constexpr int normalTest = 0b0101101000; 4219 static constexpr int positiveTest = 0b1111000000; 4220 static constexpr int snanTest = 0b0000000001; 4221 static constexpr int subnormalTest = 0b0010010000; 4222 static constexpr int zeroTest = 0b0001100000; 4223 4224 mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType, 4225 llvm::ArrayRef<mlir::Value> args, 4226 int fpclass) { 4227 assert(args.size() == 1); 4228 mlir::Type i1Ty = builder.getI1Type(); 4229 mlir::Value isfpclass = 4230 builder.create<mlir::LLVM::IsFPClass>(loc, i1Ty, args[0], fpclass); 4231 return builder.createConvert(loc, resultType, isfpclass); 4232 } 4233 4234 // Generate a quiet NaN of a given floating point type. 4235 mlir::Value IntrinsicLibrary::genQNan(mlir::Type resultType) { 4236 return genIeeeValue(resultType, builder.createIntegerConstant( 4237 loc, builder.getIntegerType(8), 4238 _FORTRAN_RUNTIME_IEEE_QUIET_NAN)); 4239 } 4240 4241 // Generate code to raise \p excepts if \p cond is absent, or present and true. 4242 void IntrinsicLibrary::genRaiseExcept(int excepts, mlir::Value cond) { 4243 fir::IfOp ifOp; 4244 if (cond) { 4245 ifOp = builder.create<fir::IfOp>(loc, cond, /*withElseRegion=*/false); 4246 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 4247 } 4248 mlir::Type i32Ty = builder.getIntegerType(32); 4249 genRuntimeCall( 4250 "feraiseexcept", i32Ty, 4251 fir::runtime::genMapExcept( 4252 builder, loc, builder.createIntegerConstant(loc, i32Ty, excepts))); 4253 if (cond) 4254 builder.setInsertionPointAfter(ifOp); 4255 } 4256 4257 // Return a reference to the contents of a derived type with one field. 4258 // Also return the field type. 4259 static std::pair<mlir::Value, mlir::Type> 4260 getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec, 4261 unsigned index = 0) { 4262 auto recType = 4263 mlir::dyn_cast<fir::RecordType>(fir::unwrapPassByRefType(rec.getType())); 4264 assert(index < recType.getTypeList().size() && "not enough components"); 4265 auto [fieldName, fieldTy] = recType.getTypeList()[index]; 4266 mlir::Value field = builder.create<fir::FieldIndexOp>( 4267 loc, fir::FieldType::get(recType.getContext()), fieldName, recType, 4268 fir::getTypeParams(rec)); 4269 return {builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy), 4270 rec, field), 4271 fieldTy}; 4272 } 4273 4274 // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=) 4275 // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=) 4276 template <mlir::arith::CmpIPredicate pred> 4277 mlir::Value 4278 IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType, 4279 llvm::ArrayRef<mlir::Value> args) { 4280 assert(args.size() == 2); 4281 auto [leftRef, fieldTy] = getFieldRef(builder, loc, args[0]); 4282 auto [rightRef, ignore] = getFieldRef(builder, loc, args[1]); 4283 mlir::Value left = builder.create<fir::LoadOp>(loc, fieldTy, leftRef); 4284 mlir::Value right = builder.create<fir::LoadOp>(loc, fieldTy, rightRef); 4285 return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right); 4286 } 4287 4288 // IEEE_CLASS 4289 mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType, 4290 llvm::ArrayRef<mlir::Value> args) { 4291 // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via 4292 // a table lookup on an index built from 5 values derived from X. 4293 // In indexing order, the values are: 4294 // 4295 // [s] sign bit 4296 // [e] exponent != 0 4297 // [m] exponent == 1..1 (max exponent) 4298 // [l] low-order significand != 0 4299 // [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit) 4300 // 4301 // kind=10 values have an explicit high-order integer significand bit, 4302 // whereas this bit is implicit for other kinds. This requires using a 6-bit 4303 // index into a 64-slot table for kind=10 argument classification queries 4304 // vs. a 5-bit index into a 32-slot table for other argument kind queries. 4305 // The instruction sequence is the same for the two cases. 4306 // 4307 // Placing the [l] and [h] significand bits in "swapped" order rather than 4308 // "natural" order enables more efficient generated code. 4309 4310 assert(args.size() == 1); 4311 mlir::Value realVal = args[0]; 4312 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType()); 4313 const unsigned intWidth = realType.getWidth(); 4314 mlir::Type intType = builder.getIntegerType(intWidth); 4315 mlir::Value intVal = 4316 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal); 4317 llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable); 4318 uint64_t highSignificandSize = (realType.getWidth() == 80) + 1; 4319 4320 // Get masks and shift counts. 4321 mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask; 4322 auto createIntegerConstant = [&](uint64_t k) { 4323 return builder.createIntegerConstant(loc, intType, k); 4324 }; 4325 auto createIntegerConstantAPI = [&](const llvm::APInt &apInt) { 4326 return builder.create<mlir::arith::ConstantOp>( 4327 loc, intType, builder.getIntegerAttr(intType, apInt)); 4328 }; 4329 auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize, 4330 uint64_t significandSize, 4331 bool hasExplicitBit = false) { 4332 assert(1 + exponentSize + significandSize == totalSize && 4333 "invalid floating point fields"); 4334 uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1; 4335 signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4); 4336 highSignificandShift = createIntegerConstant(lowSignificandSize); 4337 llvm::APInt exponentMaskAPI = 4338 llvm::APInt::getBitsSet(intWidth, /*lo=*/significandSize, 4339 /*hi=*/significandSize + exponentSize); 4340 exponentMask = createIntegerConstantAPI(exponentMaskAPI); 4341 llvm::APInt lowSignificandMaskAPI = 4342 llvm::APInt::getLowBitsSet(intWidth, lowSignificandSize); 4343 lowSignificandMask = createIntegerConstantAPI(lowSignificandMaskAPI); 4344 }; 4345 switch (realType.getWidth()) { 4346 case 16: 4347 if (realType.isF16()) { 4348 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits 4349 getMasksAndShifts(16, 5, 10); 4350 } else { 4351 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits 4352 getMasksAndShifts(16, 8, 7); 4353 } 4354 break; 4355 case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits 4356 getMasksAndShifts(32, 8, 23); 4357 break; 4358 case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits 4359 getMasksAndShifts(64, 11, 52); 4360 break; 4361 case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits 4362 getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true); 4363 tableName = RTNAME_STRING(IeeeClassTable_10); 4364 break; 4365 case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits 4366 getMasksAndShifts(128, 15, 112); 4367 break; 4368 default: 4369 llvm_unreachable("unknown real type"); 4370 } 4371 4372 // [s] sign bit 4373 int pos = 3 + highSignificandSize; 4374 mlir::Value index = builder.create<mlir::arith::AndIOp>( 4375 loc, builder.create<mlir::arith::ShRUIOp>(loc, intVal, signShift), 4376 createIntegerConstant(1ULL << pos)); 4377 4378 // [e] exponent != 0 4379 mlir::Value exponent = 4380 builder.create<mlir::arith::AndIOp>(loc, intVal, exponentMask); 4381 mlir::Value zero = createIntegerConstant(0); 4382 index = builder.create<mlir::arith::OrIOp>( 4383 loc, index, 4384 builder.create<mlir::arith::SelectOp>( 4385 loc, 4386 builder.create<mlir::arith::CmpIOp>( 4387 loc, mlir::arith::CmpIPredicate::ne, exponent, zero), 4388 createIntegerConstant(1ULL << --pos), zero)); 4389 4390 // [m] exponent == 1..1 (max exponent) 4391 index = builder.create<mlir::arith::OrIOp>( 4392 loc, index, 4393 builder.create<mlir::arith::SelectOp>( 4394 loc, 4395 builder.create<mlir::arith::CmpIOp>( 4396 loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask), 4397 createIntegerConstant(1ULL << --pos), zero)); 4398 4399 // [l] low-order significand != 0 4400 index = builder.create<mlir::arith::OrIOp>( 4401 loc, index, 4402 builder.create<mlir::arith::SelectOp>( 4403 loc, 4404 builder.create<mlir::arith::CmpIOp>( 4405 loc, mlir::arith::CmpIPredicate::ne, 4406 builder.create<mlir::arith::AndIOp>(loc, intVal, 4407 lowSignificandMask), 4408 zero), 4409 createIntegerConstant(1ULL << --pos), zero)); 4410 4411 // [h] high-order significand (1 or 2 bits) 4412 index = builder.create<mlir::arith::OrIOp>( 4413 loc, index, 4414 builder.create<mlir::arith::AndIOp>( 4415 loc, 4416 builder.create<mlir::arith::ShRUIOp>(loc, intVal, 4417 highSignificandShift), 4418 createIntegerConstant((1 << highSignificandSize) - 1))); 4419 4420 int tableSize = 1 << (4 + highSignificandSize); 4421 mlir::Type int8Ty = builder.getIntegerType(8); 4422 mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty); 4423 if (!builder.getNamedGlobal(tableName)) { 4424 llvm::SmallVector<mlir::Attribute, 64> values; 4425 auto insert = [&](std::int8_t which) { 4426 values.push_back(builder.getIntegerAttr(int8Ty, which)); 4427 }; 4428 // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0, 4429 // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible 4430 // combinations. 4431 constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE; 4432 if (tableSize == 32) { 4433 // s e m l h kinds 2,3,4,8,16 4434 // =================================================================== 4435 /* 0 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO); 4436 /* 0 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4437 /* 0 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4438 /* 0 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4439 /* 0 0 1 0 0 */ insert(impossible); 4440 /* 0 0 1 0 1 */ insert(impossible); 4441 /* 0 0 1 1 0 */ insert(impossible); 4442 /* 0 0 1 1 1 */ insert(impossible); 4443 /* 0 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4444 /* 0 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4445 /* 0 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4446 /* 0 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4447 /* 0 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF); 4448 /* 0 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4449 /* 0 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN); 4450 /* 0 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4451 /* 1 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO); 4452 /* 1 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4453 /* 1 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4454 /* 1 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4455 /* 1 0 1 0 0 */ insert(impossible); 4456 /* 1 0 1 0 1 */ insert(impossible); 4457 /* 1 0 1 1 0 */ insert(impossible); 4458 /* 1 0 1 1 1 */ insert(impossible); 4459 /* 1 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4460 /* 1 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4461 /* 1 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4462 /* 1 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4463 /* 1 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF); 4464 /* 1 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4465 /* 1 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN); 4466 /* 1 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4467 } else { 4468 // Unlike values of other kinds, kind=10 values can be "invalid", and 4469 // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns. 4470 // Runtime IO may print an invalid value as a NaN. 4471 constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE; 4472 // s e m l h kind 10 4473 // =================================================================== 4474 /* 0 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO); 4475 /* 0 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4476 /* 0 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4477 /* 0 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4478 /* 0 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4479 /* 0 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4480 /* 0 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4481 /* 0 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL); 4482 /* 0 0 1 0 00 */ insert(impossible); 4483 /* 0 0 1 0 01 */ insert(impossible); 4484 /* 0 0 1 0 10 */ insert(impossible); 4485 /* 0 0 1 0 11 */ insert(impossible); 4486 /* 0 0 1 1 00 */ insert(impossible); 4487 /* 0 0 1 1 01 */ insert(impossible); 4488 /* 0 0 1 1 10 */ insert(impossible); 4489 /* 0 0 1 1 11 */ insert(impossible); 4490 /* 0 1 0 0 00 */ insert(invalid); 4491 /* 0 1 0 0 01 */ insert(invalid); 4492 /* 0 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4493 /* 0 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4494 /* 0 1 0 1 00 */ insert(invalid); 4495 /* 0 1 0 1 01 */ insert(invalid); 4496 /* 0 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4497 /* 0 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL); 4498 /* 0 1 1 0 00 */ insert(invalid); 4499 /* 0 1 1 0 01 */ insert(invalid); 4500 /* 0 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF); 4501 /* 0 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4502 /* 0 1 1 1 00 */ insert(invalid); 4503 /* 0 1 1 1 01 */ insert(invalid); 4504 /* 0 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN); 4505 /* 0 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4506 /* 1 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO); 4507 /* 1 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4508 /* 1 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4509 /* 1 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4510 /* 1 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4511 /* 1 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4512 /* 1 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4513 /* 1 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL); 4514 /* 1 0 1 0 00 */ insert(impossible); 4515 /* 1 0 1 0 01 */ insert(impossible); 4516 /* 1 0 1 0 10 */ insert(impossible); 4517 /* 1 0 1 0 11 */ insert(impossible); 4518 /* 1 0 1 1 00 */ insert(impossible); 4519 /* 1 0 1 1 01 */ insert(impossible); 4520 /* 1 0 1 1 10 */ insert(impossible); 4521 /* 1 0 1 1 11 */ insert(impossible); 4522 /* 1 1 0 0 00 */ insert(invalid); 4523 /* 1 1 0 0 01 */ insert(invalid); 4524 /* 1 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4525 /* 1 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4526 /* 1 1 0 1 00 */ insert(invalid); 4527 /* 1 1 0 1 01 */ insert(invalid); 4528 /* 1 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4529 /* 1 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL); 4530 /* 1 1 1 0 00 */ insert(invalid); 4531 /* 1 1 1 0 01 */ insert(invalid); 4532 /* 1 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF); 4533 /* 1 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4534 /* 1 1 1 1 00 */ insert(invalid); 4535 /* 1 1 1 1 01 */ insert(invalid); 4536 /* 1 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN); 4537 /* 1 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN); 4538 } 4539 builder.createGlobalConstant( 4540 loc, tableTy, tableName, builder.createLinkOnceLinkage(), 4541 mlir::DenseElementsAttr::get( 4542 mlir::RankedTensorType::get(tableSize, int8Ty), values)); 4543 } 4544 4545 return builder.create<fir::CoordinateOp>( 4546 loc, builder.getRefType(resultType), 4547 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy), 4548 builder.getSymbolRefAttr(tableName)), 4549 index); 4550 } 4551 4552 // IEEE_COPY_SIGN 4553 mlir::Value 4554 IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType, 4555 llvm::ArrayRef<mlir::Value> args) { 4556 // Copy the sign of REAL arg Y to REAL arg X. 4557 assert(args.size() == 2); 4558 mlir::Value xRealVal = args[0]; 4559 mlir::Value yRealVal = args[1]; 4560 mlir::FloatType xRealType = 4561 mlir::dyn_cast<mlir::FloatType>(xRealVal.getType()); 4562 mlir::FloatType yRealType = 4563 mlir::dyn_cast<mlir::FloatType>(yRealVal.getType()); 4564 4565 if (yRealType == mlir::BFloat16Type::get(builder.getContext())) { 4566 // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y. 4567 // This conversion should always preserve the sign bit. 4568 yRealVal = builder.createConvert( 4569 loc, mlir::Float32Type::get(builder.getContext()), yRealVal); 4570 yRealType = mlir::Float32Type::get(builder.getContext()); 4571 } 4572 4573 // Args have the same type. 4574 if (xRealType == yRealType) 4575 return builder.create<mlir::math::CopySignOp>(loc, xRealVal, yRealVal); 4576 4577 // Args have different types. 4578 mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth()); 4579 mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth()); 4580 mlir::Value xIntVal = 4581 builder.create<mlir::arith::BitcastOp>(loc, xIntType, xRealVal); 4582 mlir::Value yIntVal = 4583 builder.create<mlir::arith::BitcastOp>(loc, yIntType, yRealVal); 4584 mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0); 4585 mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0); 4586 mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1); 4587 mlir::Value ySign = builder.create<mlir::arith::ShRUIOp>( 4588 loc, yIntVal, 4589 builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1)); 4590 mlir::Value xAbs = builder.create<mlir::arith::ShRUIOp>( 4591 loc, builder.create<mlir::arith::ShLIOp>(loc, xIntVal, xOne), xOne); 4592 mlir::Value xSign = builder.create<mlir::arith::SelectOp>( 4593 loc, 4594 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::eq, 4595 ySign, yZero), 4596 xZero, 4597 builder.create<mlir::arith::ShLIOp>( 4598 loc, xOne, 4599 builder.createIntegerConstant(loc, xIntType, 4600 xRealType.getWidth() - 1))); 4601 return builder.create<mlir::arith::BitcastOp>( 4602 loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign)); 4603 } 4604 4605 // IEEE_GET_FLAG 4606 void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) { 4607 assert(args.size() == 2); 4608 // Set FLAG_VALUE=.TRUE. if the exception specified by FLAG is signaling. 4609 mlir::Value flag = fir::getBase(args[0]); 4610 mlir::Value flagValue = fir::getBase(args[1]); 4611 mlir::Type resultTy = 4612 mlir::dyn_cast<fir::ReferenceType>(flagValue.getType()).getEleTy(); 4613 mlir::Type i32Ty = builder.getIntegerType(32); 4614 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0); 4615 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag); 4616 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef); 4617 mlir::Value excepts = IntrinsicLibrary::genRuntimeCall( 4618 "fetestexcept", i32Ty, 4619 fir::runtime::genMapExcept( 4620 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field))); 4621 mlir::Value logicalResult = builder.create<fir::ConvertOp>( 4622 loc, resultTy, 4623 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne, 4624 excepts, zero)); 4625 builder.create<fir::StoreOp>(loc, logicalResult, flagValue); 4626 } 4627 4628 // IEEE_GET_HALTING_MODE 4629 void IntrinsicLibrary::genIeeeGetHaltingMode( 4630 llvm::ArrayRef<fir::ExtendedValue> args) { 4631 // Set HALTING=.TRUE. if the exception specified by FLAG will cause halting. 4632 assert(args.size() == 2); 4633 mlir::Value flag = fir::getBase(args[0]); 4634 mlir::Value halting = fir::getBase(args[1]); 4635 mlir::Type resultTy = 4636 mlir::dyn_cast<fir::ReferenceType>(halting.getType()).getEleTy(); 4637 mlir::Type i32Ty = builder.getIntegerType(32); 4638 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0); 4639 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag); 4640 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef); 4641 mlir::Value haltSet = 4642 IntrinsicLibrary::genRuntimeCall("fegetexcept", i32Ty, {}); 4643 mlir::Value intResult = builder.create<mlir::arith::AndIOp>( 4644 loc, haltSet, 4645 fir::runtime::genMapExcept( 4646 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field))); 4647 mlir::Value logicalResult = builder.create<fir::ConvertOp>( 4648 loc, resultTy, 4649 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne, 4650 intResult, zero)); 4651 builder.create<fir::StoreOp>(loc, logicalResult, halting); 4652 } 4653 4654 // IEEE_GET_MODES, IEEE_SET_MODES 4655 // IEEE_GET_STATUS, IEEE_SET_STATUS 4656 template <bool isGet, bool isModes> 4657 void IntrinsicLibrary::genIeeeGetOrSetModesOrStatus( 4658 llvm::ArrayRef<fir::ExtendedValue> args) { 4659 assert(args.size() == 1); 4660 #ifndef __GLIBC_USE_IEC_60559_BFP_EXT // only use of "#include <cfenv>" 4661 // No definitions of fegetmode, fesetmode 4662 llvm::StringRef func = isModes 4663 ? (isGet ? "ieee_get_modes" : "ieee_set_modes") 4664 : (isGet ? "ieee_get_status" : "ieee_set_status"); 4665 TODO(loc, "intrinsic module procedure: " + func); 4666 #else 4667 mlir::Type i32Ty = builder.getIntegerType(32); 4668 mlir::Type i64Ty = builder.getIntegerType(64); 4669 mlir::Type ptrTy = builder.getRefType(i32Ty); 4670 mlir::Value addr; 4671 if (fir::getTargetTriple(builder.getModule()).isSPARC()) { 4672 // Floating point environment data is larger than the __data field 4673 // allotment. Allocate data space from the heap. 4674 auto [fieldRef, fieldTy] = 4675 getFieldRef(builder, loc, fir::getBase(args[0]), 1); 4676 addr = builder.create<fir::BoxAddrOp>( 4677 loc, builder.create<fir::LoadOp>(loc, fieldRef)); 4678 mlir::Type heapTy = addr.getType(); 4679 mlir::Value allocated = builder.create<mlir::arith::CmpIOp>( 4680 loc, mlir::arith::CmpIPredicate::ne, 4681 builder.createConvert(loc, i64Ty, addr), 4682 builder.createIntegerConstant(loc, i64Ty, 0)); 4683 auto ifOp = builder.create<fir::IfOp>(loc, heapTy, allocated, 4684 /*withElseRegion=*/true); 4685 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 4686 builder.create<fir::ResultOp>(loc, addr); 4687 builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 4688 mlir::Value byteSize = 4689 isModes ? fir::runtime::genGetModesTypeSize(builder, loc) 4690 : fir::runtime::genGetStatusTypeSize(builder, loc); 4691 byteSize = builder.createConvert(loc, builder.getIndexType(), byteSize); 4692 addr = 4693 builder.create<fir::AllocMemOp>(loc, extractSequenceType(heapTy), 4694 /*typeparams=*/std::nullopt, byteSize); 4695 mlir::Value shape = builder.create<fir::ShapeOp>(loc, byteSize); 4696 builder.create<fir::StoreOp>( 4697 loc, builder.create<fir::EmboxOp>(loc, fieldTy, addr, shape), fieldRef); 4698 builder.create<fir::ResultOp>(loc, addr); 4699 builder.setInsertionPointAfter(ifOp); 4700 addr = builder.create<fir::ConvertOp>(loc, ptrTy, ifOp.getResult(0)); 4701 } else { 4702 // Place floating point environment data in __data storage. 4703 addr = builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0])); 4704 } 4705 llvm::StringRef func = isModes ? (isGet ? "fegetmode" : "fesetmode") 4706 : (isGet ? "fegetenv" : "fesetenv"); 4707 genRuntimeCall(func, i32Ty, addr); 4708 #endif 4709 } 4710 4711 // Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2. 4712 static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc, 4713 mlir::Value radix, std::string procName) { 4714 mlir::Value notTwo = builder.create<mlir::arith::CmpIOp>( 4715 loc, mlir::arith::CmpIPredicate::ne, radix, 4716 builder.createIntegerConstant(loc, radix.getType(), 2)); 4717 auto ifOp = builder.create<fir::IfOp>(loc, notTwo, 4718 /*withElseRegion=*/false); 4719 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 4720 fir::runtime::genReportFatalUserError(builder, loc, 4721 procName + " radix argument must be 2"); 4722 builder.setInsertionPointAfter(ifOp); 4723 } 4724 4725 // IEEE_GET_ROUNDING_MODE 4726 void IntrinsicLibrary::genIeeeGetRoundingMode( 4727 llvm::ArrayRef<fir::ExtendedValue> args) { 4728 // Set arg ROUNDING_VALUE to the current floating point rounding mode. 4729 // Values are chosen to match the llvm.get.rounding encoding. 4730 // Generate an error if the value of optional arg RADIX is not 2. 4731 assert(args.size() == 1 || args.size() == 2); 4732 if (args.size() == 2) 4733 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode"); 4734 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0])); 4735 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder); 4736 mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0); 4737 mode = builder.createConvert(loc, fieldTy, mode); 4738 builder.create<fir::StoreOp>(loc, mode, fieldRef); 4739 } 4740 4741 // IEEE_GET_UNDERFLOW_MODE 4742 void IntrinsicLibrary::genIeeeGetUnderflowMode( 4743 llvm::ArrayRef<fir::ExtendedValue> args) { 4744 assert(args.size() == 1); 4745 mlir::Value flag = fir::runtime::genGetUnderflowMode(builder, loc); 4746 builder.createStoreWithConvert(loc, flag, fir::getBase(args[0])); 4747 } 4748 4749 // IEEE_INT 4750 mlir::Value IntrinsicLibrary::genIeeeInt(mlir::Type resultType, 4751 llvm::ArrayRef<mlir::Value> args) { 4752 // Convert real argument A to an integer, with rounding according to argument 4753 // ROUND. Signal IEEE_INVALID if A is a NaN, an infinity, or out of range, 4754 // and return either the largest or smallest integer result value (*). 4755 // For valid results (when IEEE_INVALID is not signaled), signal IEEE_INEXACT 4756 // if A is not an exact integral value (*). The (*) choices are processor 4757 // dependent implementation choices not mandated by the standard. 4758 // The primary result is generated with a call to IEEE_RINT. 4759 assert(args.size() == 3); 4760 mlir::FloatType realType = mlir::cast<mlir::FloatType>(args[0].getType()); 4761 mlir::Value realResult = genIeeeRint(realType, {args[0], args[1]}); 4762 int intWidth = mlir::cast<mlir::IntegerType>(resultType).getWidth(); 4763 mlir::Value intLBound = builder.create<mlir::arith::ConstantOp>( 4764 loc, resultType, 4765 builder.getIntegerAttr(resultType, 4766 llvm::APInt::getBitsSet(intWidth, 4767 /*lo=*/intWidth - 1, 4768 /*hi=*/intWidth))); 4769 mlir::Value intUBound = builder.create<mlir::arith::ConstantOp>( 4770 loc, resultType, 4771 builder.getIntegerAttr(resultType, 4772 llvm::APInt::getBitsSet(intWidth, /*lo=*/0, 4773 /*hi=*/intWidth - 1))); 4774 mlir::Value realLBound = 4775 builder.create<fir::ConvertOp>(loc, realType, intLBound); 4776 mlir::Value realUBound = builder.create<mlir::arith::NegFOp>(loc, realLBound); 4777 mlir::Value aGreaterThanLBound = builder.create<mlir::arith::CmpFOp>( 4778 loc, mlir::arith::CmpFPredicate::OGE, realResult, realLBound); 4779 mlir::Value aLessThanUBound = builder.create<mlir::arith::CmpFOp>( 4780 loc, mlir::arith::CmpFPredicate::OLT, realResult, realUBound); 4781 mlir::Value resultIsValid = builder.create<mlir::arith::AndIOp>( 4782 loc, aGreaterThanLBound, aLessThanUBound); 4783 4784 // Result is valid. It may be exact or inexact. 4785 mlir::Value result; 4786 fir::IfOp ifOp = builder.create<fir::IfOp>(loc, resultType, resultIsValid, 4787 /*withElseRegion=*/true); 4788 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 4789 mlir::Value inexact = builder.create<mlir::arith::CmpFOp>( 4790 loc, mlir::arith::CmpFPredicate::ONE, args[0], realResult); 4791 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact); 4792 result = builder.create<fir::ConvertOp>(loc, resultType, realResult); 4793 builder.create<fir::ResultOp>(loc, result); 4794 4795 // Result is invalid. 4796 builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 4797 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID); 4798 result = builder.create<mlir::arith::SelectOp>(loc, aGreaterThanLBound, 4799 intUBound, intLBound); 4800 builder.create<fir::ResultOp>(loc, result); 4801 builder.setInsertionPointAfter(ifOp); 4802 return ifOp.getResult(0); 4803 } 4804 4805 // IEEE_IS_FINITE 4806 mlir::Value 4807 IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType, 4808 llvm::ArrayRef<mlir::Value> args) { 4809 // Check if arg X is a (negative or positive) (normal, denormal, or zero). 4810 assert(args.size() == 1); 4811 return genIsFPClass(resultType, args, finiteTest); 4812 } 4813 4814 // IEEE_IS_NAN 4815 mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType, 4816 llvm::ArrayRef<mlir::Value> args) { 4817 // Check if arg X is a (signaling or quiet) NaN. 4818 assert(args.size() == 1); 4819 return genIsFPClass(resultType, args, nanTest); 4820 } 4821 4822 // IEEE_IS_NEGATIVE 4823 mlir::Value 4824 IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType, 4825 llvm::ArrayRef<mlir::Value> args) { 4826 // Check if arg X is a negative (infinity, normal, denormal or zero). 4827 assert(args.size() == 1); 4828 return genIsFPClass(resultType, args, negativeTest); 4829 } 4830 4831 // IEEE_IS_NORMAL 4832 mlir::Value 4833 IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType, 4834 llvm::ArrayRef<mlir::Value> args) { 4835 // Check if arg X is a (negative or positive) (normal or zero). 4836 assert(args.size() == 1); 4837 return genIsFPClass(resultType, args, normalTest); 4838 } 4839 4840 // IEEE_LOGB 4841 mlir::Value IntrinsicLibrary::genIeeeLogb(mlir::Type resultType, 4842 llvm::ArrayRef<mlir::Value> args) { 4843 // Exponent of X, with special case treatment for some input values. 4844 // Return: X == 0 4845 // ? -infinity (and raise FE_DIVBYZERO) 4846 // : ieee_is_finite(X) 4847 // ? exponent(X) - 1 // unbiased exponent of X 4848 // : ieee_copy_sign(X, 1.0) // +infinity or NaN 4849 assert(args.size() == 1); 4850 mlir::Value realVal = args[0]; 4851 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType()); 4852 int bitWidth = realType.getWidth(); 4853 mlir::Type intType = builder.getIntegerType(realType.getWidth()); 4854 mlir::Value intVal = 4855 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal); 4856 mlir::Type i1Ty = builder.getI1Type(); 4857 4858 int exponentBias, significandSize, nonSignificandSize; 4859 switch (bitWidth) { 4860 case 16: 4861 if (realType.isF16()) { 4862 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits 4863 exponentBias = (1 << (5 - 1)) - 1; // 15 4864 significandSize = 10; 4865 nonSignificandSize = 6; 4866 break; 4867 } 4868 assert(realType.isBF16() && "unknown 16-bit real type"); 4869 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits 4870 exponentBias = (1 << (8 - 1)) - 1; // 127 4871 significandSize = 7; 4872 nonSignificandSize = 9; 4873 break; 4874 case 32: 4875 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits 4876 exponentBias = (1 << (8 - 1)) - 1; // 127 4877 significandSize = 23; 4878 nonSignificandSize = 9; 4879 break; 4880 case 64: 4881 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits 4882 exponentBias = (1 << (11 - 1)) - 1; // 1023 4883 significandSize = 52; 4884 nonSignificandSize = 12; 4885 break; 4886 case 80: 4887 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits 4888 exponentBias = (1 << (15 - 1)) - 1; // 16383 4889 significandSize = 64; 4890 nonSignificandSize = 16 + 1; 4891 break; 4892 case 128: 4893 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits 4894 exponentBias = (1 << (15 - 1)) - 1; // 16383 4895 significandSize = 112; 4896 nonSignificandSize = 16; 4897 break; 4898 default: 4899 llvm_unreachable("unknown real type"); 4900 } 4901 4902 mlir::Value isZero = builder.create<mlir::arith::CmpFOp>( 4903 loc, mlir::arith::CmpFPredicate::OEQ, realVal, 4904 builder.createRealZeroConstant(loc, resultType)); 4905 auto outerIfOp = builder.create<fir::IfOp>(loc, resultType, isZero, 4906 /*withElseRegion=*/true); 4907 // X is zero -- result is -infinity 4908 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front()); 4909 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO); 4910 mlir::Value ones = builder.createAllOnesInteger(loc, intType); 4911 mlir::Value result = builder.create<mlir::arith::ShLIOp>( 4912 loc, ones, 4913 builder.createIntegerConstant(loc, intType, 4914 // kind=10 high-order bit is explicit 4915 significandSize - (bitWidth == 80))); 4916 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result); 4917 builder.create<fir::ResultOp>(loc, result); 4918 4919 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front()); 4920 mlir::Value one = builder.createIntegerConstant(loc, intType, 1); 4921 mlir::Value shiftLeftOne = 4922 builder.create<mlir::arith::ShLIOp>(loc, intVal, one); 4923 mlir::Value isFinite = genIsFPClass(i1Ty, args, finiteTest); 4924 auto innerIfOp = builder.create<fir::IfOp>(loc, resultType, isFinite, 4925 /*withElseRegion=*/true); 4926 // X is non-zero finite -- result is unbiased exponent of X 4927 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front()); 4928 mlir::Value isNormal = genIsFPClass(i1Ty, args, normalTest); 4929 auto normalIfOp = builder.create<fir::IfOp>(loc, resultType, isNormal, 4930 /*withElseRegion=*/true); 4931 // X is normal 4932 builder.setInsertionPointToStart(&normalIfOp.getThenRegion().front()); 4933 mlir::Value biasedExponent = builder.create<mlir::arith::ShRUIOp>( 4934 loc, shiftLeftOne, 4935 builder.createIntegerConstant(loc, intType, significandSize + 1)); 4936 result = builder.create<mlir::arith::SubIOp>( 4937 loc, biasedExponent, 4938 builder.createIntegerConstant(loc, intType, exponentBias)); 4939 result = builder.create<fir::ConvertOp>(loc, resultType, result); 4940 builder.create<fir::ResultOp>(loc, result); 4941 4942 // X is denormal -- result is (-exponentBias - ctlz(significand)) 4943 builder.setInsertionPointToStart(&normalIfOp.getElseRegion().front()); 4944 mlir::Value significand = builder.create<mlir::arith::ShLIOp>( 4945 loc, intVal, 4946 builder.createIntegerConstant(loc, intType, nonSignificandSize)); 4947 mlir::Value ctlz = 4948 builder.create<mlir::math::CountLeadingZerosOp>(loc, significand); 4949 mlir::Type i32Ty = builder.getI32Type(); 4950 result = builder.create<mlir::arith::SubIOp>( 4951 loc, builder.createIntegerConstant(loc, i32Ty, -exponentBias), 4952 builder.create<fir::ConvertOp>(loc, i32Ty, ctlz)); 4953 result = builder.create<fir::ConvertOp>(loc, resultType, result); 4954 builder.create<fir::ResultOp>(loc, result); 4955 4956 builder.setInsertionPointToEnd(&innerIfOp.getThenRegion().front()); 4957 builder.create<fir::ResultOp>(loc, normalIfOp.getResult(0)); 4958 4959 // X is infinity or NaN -- result is +infinity or NaN 4960 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front()); 4961 result = builder.create<mlir::arith::ShRUIOp>(loc, shiftLeftOne, one); 4962 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result); 4963 builder.create<fir::ResultOp>(loc, result); 4964 4965 // Unwind the if nest. 4966 builder.setInsertionPointToEnd(&outerIfOp.getElseRegion().front()); 4967 builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0)); 4968 builder.setInsertionPointAfter(outerIfOp); 4969 return outerIfOp.getResult(0); 4970 } 4971 4972 // IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG 4973 // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG 4974 template <bool isMax, bool isNum, bool isMag> 4975 mlir::Value IntrinsicLibrary::genIeeeMaxMin(mlir::Type resultType, 4976 llvm::ArrayRef<mlir::Value> args) { 4977 // Maximum/minimum of X and Y with special case treatment of NaN operands. 4978 // The f18 definitions of these procedures (where applicable) are incomplete. 4979 // And f18 results involving NaNs are different from and incompatible with 4980 // f23 results. This code implements the f23 procedures. 4981 // For IEEE_MAX_MAG and IEEE_MAX_NUM_MAG: 4982 // if (ABS(X) > ABS(Y)) 4983 // return X 4984 // else if (ABS(Y) > ABS(X)) 4985 // return Y 4986 // else if (ABS(X) == ABS(Y)) 4987 // return IEEE_SIGNBIT(Y) ? X : Y 4988 // // X or Y or both are NaNs 4989 // if (X is an sNaN or Y is an sNaN) raise FE_INVALID 4990 // if (IEEE_MAX_NUM_MAG and X is not a NaN) return X 4991 // if (IEEE_MAX_NUM_MAG and Y is not a NaN) return Y 4992 // return a qNaN 4993 // For IEEE_MAX, IEEE_MAX_NUM: compare X vs. Y rather than ABS(X) vs. ABS(Y) 4994 // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG: invert comparisons 4995 assert(args.size() == 2); 4996 mlir::Value x = args[0]; 4997 mlir::Value y = args[1]; 4998 mlir::Value x1, y1; // X or ABS(X), Y or ABS(Y) 4999 if constexpr (isMag) { 5000 mlir::Value zero = builder.createRealZeroConstant(loc, resultType); 5001 x1 = builder.create<mlir::math::CopySignOp>(loc, x, zero); 5002 y1 = builder.create<mlir::math::CopySignOp>(loc, y, zero); 5003 } else { 5004 x1 = x; 5005 y1 = y; 5006 } 5007 mlir::Type i1Ty = builder.getI1Type(); 5008 mlir::arith::CmpFPredicate pred; 5009 mlir::Value cmp, result, resultIsX, resultIsY; 5010 5011 // X1 < Y1 -- MAX result is Y; MIN result is X. 5012 pred = mlir::arith::CmpFPredicate::OLT; 5013 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1); 5014 auto ifOp1 = builder.create<fir::IfOp>(loc, resultType, cmp, true); 5015 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front()); 5016 result = isMax ? y : x; 5017 builder.create<fir::ResultOp>(loc, result); 5018 5019 // X1 > Y1 -- MAX result is X; MIN result is Y. 5020 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front()); 5021 pred = mlir::arith::CmpFPredicate::OGT; 5022 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1); 5023 auto ifOp2 = builder.create<fir::IfOp>(loc, resultType, cmp, true); 5024 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front()); 5025 result = isMax ? x : y; 5026 builder.create<fir::ResultOp>(loc, result); 5027 5028 // X1 == Y1 -- MAX favors a positive result; MIN favors a negative result. 5029 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front()); 5030 pred = mlir::arith::CmpFPredicate::OEQ; 5031 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1); 5032 auto ifOp3 = builder.create<fir::IfOp>(loc, resultType, cmp, true); 5033 builder.setInsertionPointToStart(&ifOp3.getThenRegion().front()); 5034 resultIsX = isMax ? genIsFPClass(i1Ty, x, positiveTest) 5035 : genIsFPClass(i1Ty, x, negativeTest); 5036 result = builder.create<mlir::arith::SelectOp>(loc, resultIsX, x, y); 5037 builder.create<fir::ResultOp>(loc, result); 5038 5039 // X or Y or both are NaNs -- result may be X, Y, or a qNaN 5040 builder.setInsertionPointToStart(&ifOp3.getElseRegion().front()); 5041 if constexpr (isNum) { 5042 pred = mlir::arith::CmpFPredicate::ORD; // check for a non-NaN 5043 resultIsX = builder.create<mlir::arith::CmpFOp>(loc, pred, x, x); 5044 resultIsY = builder.create<mlir::arith::CmpFOp>(loc, pred, y, y); 5045 } else { 5046 resultIsX = resultIsY = builder.createBool(loc, false); 5047 } 5048 result = builder.create<mlir::arith::SelectOp>( 5049 loc, resultIsX, x, 5050 builder.create<mlir::arith::SelectOp>(loc, resultIsY, y, 5051 genQNan(resultType))); 5052 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>( 5053 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest), 5054 genIsFPClass(builder.getI1Type(), args[1], snanTest)); 5055 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp); 5056 builder.create<fir::ResultOp>(loc, result); 5057 5058 // Unwind the if nest. 5059 builder.setInsertionPointAfter(ifOp3); 5060 builder.create<fir::ResultOp>(loc, ifOp3.getResult(0)); 5061 builder.setInsertionPointAfter(ifOp2); 5062 builder.create<fir::ResultOp>(loc, ifOp2.getResult(0)); 5063 builder.setInsertionPointAfter(ifOp1); 5064 return ifOp1.getResult(0); 5065 } 5066 5067 // IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT, 5068 // IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE 5069 template <mlir::arith::CmpFPredicate pred> 5070 mlir::Value 5071 IntrinsicLibrary::genIeeeQuietCompare(mlir::Type resultType, 5072 llvm::ArrayRef<mlir::Value> args) { 5073 // Compare X and Y with special case treatment of NaN operands. 5074 assert(args.size() == 2); 5075 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>( 5076 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest), 5077 genIsFPClass(builder.getI1Type(), args[1], snanTest)); 5078 mlir::Value res = 5079 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]); 5080 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp); 5081 return builder.create<fir::ConvertOp>(loc, resultType, res); 5082 } 5083 5084 // IEEE_REAL 5085 mlir::Value IntrinsicLibrary::genIeeeReal(mlir::Type resultType, 5086 llvm::ArrayRef<mlir::Value> args) { 5087 // Convert integer or real argument A to a real of a specified kind. 5088 // Round according to the current rounding mode. 5089 // Signal IEEE_INVALID if A is an sNaN, and return a qNaN. 5090 // Signal IEEE_UNDERFLOW for an inexact subnormal or zero result. 5091 // Signal IEEE_OVERFLOW if A is finite and the result is infinite. 5092 // Signal IEEE_INEXACT for an inexact result. 5093 // 5094 // if (type(a) == resultType) { 5095 // // Conversion to the same type is a nop except for sNaN processing. 5096 // result = a 5097 // } else { 5098 // result = r = real(a, kind(result)) 5099 // // Conversion to a larger type is exact. 5100 // if (c_sizeof(a) >= c_sizeof(r)) { 5101 // b = (a is integer) ? int(r, kind(a)) : real(r, kind(a)) 5102 // if (a == b || isNaN(a)) { 5103 // // a is {-0, +0, -inf, +inf, NaN} or exact; result is r 5104 // } else { 5105 // // odd(r) is true if the low bit of significand(r) is 1 5106 // // rounding mode ieee_other is an alias for mode ieee_nearest 5107 // if (a < b) { 5108 // if (mode == ieee_nearest && odd(r)) result = ieee_next_down(r) 5109 // if (mode == ieee_other && odd(r)) result = ieee_next_down(r) 5110 // if (mode == ieee_to_zero && a > 0) result = ieee_next_down(r) 5111 // if (mode == ieee_away && a < 0) result = ieee_next_down(r) 5112 // if (mode == ieee_down) result = ieee_next_down(r) 5113 // } else { // a > b 5114 // if (mode == ieee_nearest && odd(r)) result = ieee_next_up(r) 5115 // if (mode == ieee_other && odd(r)) result = ieee_next_up(r) 5116 // if (mode == ieee_to_zero && a < 0) result = ieee_next_up(r) 5117 // if (mode == ieee_away && a > 0) result = ieee_next_up(r) 5118 // if (mode == ieee_up) result = ieee_next_up(r) 5119 // } 5120 // } 5121 // } 5122 // } 5123 5124 assert(args.size() == 2); 5125 mlir::Type i1Ty = builder.getI1Type(); 5126 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext()); 5127 mlir::Value a = args[0]; 5128 mlir::Type aType = a.getType(); 5129 5130 // If the argument is an sNaN, raise an invalid exception and return a qNaN. 5131 // Otherwise return the argument. 5132 auto processSnan = [&](mlir::Value x) { 5133 fir::IfOp ifOp = builder.create<fir::IfOp>(loc, resultType, 5134 genIsFPClass(i1Ty, x, snanTest), 5135 /*withElseRegion=*/true); 5136 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 5137 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID); 5138 builder.create<fir::ResultOp>(loc, genQNan(resultType)); 5139 builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 5140 builder.create<fir::ResultOp>(loc, x); 5141 builder.setInsertionPointAfter(ifOp); 5142 return ifOp.getResult(0); 5143 }; 5144 5145 // Conversion is a nop, except that A may be an sNaN. 5146 if (resultType == aType) 5147 return processSnan(a); 5148 5149 // Can't directly convert between kind=2 and kind=3. 5150 mlir::Value r, r1; 5151 if ((aType.isBF16() && resultType.isF16()) || 5152 (aType.isF16() && resultType.isBF16())) { 5153 a = builder.createConvert(loc, f32Ty, a); 5154 aType = f32Ty; 5155 } 5156 r = builder.create<fir::ConvertOp>(loc, resultType, a); 5157 5158 mlir::IntegerType aIntType = mlir::dyn_cast<mlir::IntegerType>(aType); 5159 mlir::FloatType aFloatType = mlir::dyn_cast<mlir::FloatType>(aType); 5160 mlir::FloatType resultFloatType = mlir::dyn_cast<mlir::FloatType>(resultType); 5161 5162 // Conversion from a smaller type to a larger type is exact. 5163 if ((aIntType ? aIntType.getWidth() : aFloatType.getWidth()) < 5164 resultFloatType.getWidth()) 5165 return aIntType ? r : processSnan(r); 5166 5167 // A possibly inexact conversion result may need to be rounded up or down. 5168 mlir::Value b = builder.create<fir::ConvertOp>(loc, aType, r); 5169 mlir::Value aEqB; 5170 if (aIntType) 5171 aEqB = builder.create<mlir::arith::CmpIOp>( 5172 loc, mlir::arith::CmpIPredicate::eq, a, b); 5173 else 5174 aEqB = builder.create<mlir::arith::CmpFOp>( 5175 loc, mlir::arith::CmpFPredicate::UEQ, a, b); 5176 5177 // [a == b] a is a NaN or r is exact (a may be -0, +0, -inf, +inf) -- return r 5178 fir::IfOp ifOp1 = builder.create<fir::IfOp>(loc, resultType, aEqB, 5179 /*withElseRegion=*/true); 5180 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front()); 5181 builder.create<fir::ResultOp>(loc, aIntType ? r : processSnan(r)); 5182 5183 // Code common to (a < b) and (a > b) branches. 5184 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front()); 5185 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder); 5186 mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0); 5187 mlir::Value aIsNegative, aIsPositive; 5188 if (aIntType) { 5189 mlir::Value zero = builder.createIntegerConstant(loc, aIntType, 0); 5190 aIsNegative = builder.create<mlir::arith::CmpIOp>( 5191 loc, mlir::arith::CmpIPredicate::slt, a, zero); 5192 aIsPositive = builder.create<mlir::arith::CmpIOp>( 5193 loc, mlir::arith::CmpIPredicate::sgt, a, zero); 5194 } else { 5195 mlir::Value zero = builder.createRealZeroConstant(loc, aFloatType); 5196 aIsNegative = builder.create<mlir::arith::CmpFOp>( 5197 loc, mlir::arith::CmpFPredicate::OLT, a, zero); 5198 aIsPositive = builder.create<mlir::arith::CmpFOp>( 5199 loc, mlir::arith::CmpFPredicate::OGT, a, zero); 5200 } 5201 mlir::Type resultIntType = builder.getIntegerType(resultFloatType.getWidth()); 5202 mlir::Value resultCast = 5203 builder.create<mlir::arith::BitcastOp>(loc, resultIntType, r); 5204 mlir::Value one = builder.createIntegerConstant(loc, resultIntType, 1); 5205 mlir::Value rIsOdd = builder.create<fir::ConvertOp>( 5206 loc, i1Ty, builder.create<mlir::arith::AndIOp>(loc, resultCast, one)); 5207 // Check for a rounding mode match. 5208 auto match = [&](int m) { 5209 return builder.create<mlir::arith::CmpIOp>( 5210 loc, mlir::arith::CmpIPredicate::eq, mode, 5211 builder.createIntegerConstant(loc, mode.getType(), m)); 5212 }; 5213 mlir::Value roundToNearestBit = builder.create<mlir::arith::OrIOp>( 5214 loc, 5215 // IEEE_OTHER is an alias for IEEE_NEAREST. 5216 match(_FORTRAN_RUNTIME_IEEE_NEAREST), match(_FORTRAN_RUNTIME_IEEE_OTHER)); 5217 mlir::Value roundToNearest = 5218 builder.create<mlir::arith::AndIOp>(loc, roundToNearestBit, rIsOdd); 5219 mlir::Value roundToZeroBit = match(_FORTRAN_RUNTIME_IEEE_TO_ZERO); 5220 mlir::Value roundAwayBit = match(_FORTRAN_RUNTIME_IEEE_AWAY); 5221 mlir::Value roundToZero, roundAway, mustAdjust; 5222 fir::IfOp adjustIfOp; 5223 mlir::Value aLtB; 5224 if (aIntType) 5225 aLtB = builder.create<mlir::arith::CmpIOp>( 5226 loc, mlir::arith::CmpIPredicate::slt, a, b); 5227 else 5228 aLtB = builder.create<mlir::arith::CmpFOp>( 5229 loc, mlir::arith::CmpFPredicate::OLT, a, b); 5230 mlir::Value upResult = 5231 builder.create<mlir::arith::AddIOp>(loc, resultCast, one); 5232 mlir::Value downResult = 5233 builder.create<mlir::arith::SubIOp>(loc, resultCast, one); 5234 5235 // (a < b): r is inexact -- return r or ieee_next_down(r) 5236 fir::IfOp ifOp2 = builder.create<fir::IfOp>(loc, resultType, aLtB, 5237 /*withElseRegion=*/true); 5238 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front()); 5239 roundToZero = 5240 builder.create<mlir::arith::AndIOp>(loc, roundToZeroBit, aIsPositive); 5241 roundAway = 5242 builder.create<mlir::arith::AndIOp>(loc, roundAwayBit, aIsNegative); 5243 mlir::Value roundDown = match(_FORTRAN_RUNTIME_IEEE_DOWN); 5244 mustAdjust = 5245 builder.create<mlir::arith::OrIOp>(loc, roundToNearest, roundToZero); 5246 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundAway); 5247 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundDown); 5248 adjustIfOp = builder.create<fir::IfOp>(loc, resultType, mustAdjust, 5249 /*withElseRegion=*/true); 5250 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front()); 5251 if (resultType.isF80()) 5252 r1 = fir::runtime::genNearest(builder, loc, r, 5253 builder.createBool(loc, false)); 5254 else 5255 r1 = builder.create<mlir::arith::BitcastOp>( 5256 loc, resultType, 5257 builder.create<mlir::arith::SelectOp>(loc, aIsNegative, upResult, 5258 downResult)); 5259 builder.create<fir::ResultOp>(loc, r1); 5260 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front()); 5261 builder.create<fir::ResultOp>(loc, r); 5262 builder.setInsertionPointAfter(adjustIfOp); 5263 builder.create<fir::ResultOp>(loc, adjustIfOp.getResult(0)); 5264 5265 // (a > b): r is inexact -- return r or ieee_next_up(r) 5266 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front()); 5267 roundToZero = 5268 builder.create<mlir::arith::AndIOp>(loc, roundToZeroBit, aIsNegative); 5269 roundAway = 5270 builder.create<mlir::arith::AndIOp>(loc, roundAwayBit, aIsPositive); 5271 mlir::Value roundUp = match(_FORTRAN_RUNTIME_IEEE_UP); 5272 mustAdjust = 5273 builder.create<mlir::arith::OrIOp>(loc, roundToNearest, roundToZero); 5274 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundAway); 5275 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundUp); 5276 adjustIfOp = builder.create<fir::IfOp>(loc, resultType, mustAdjust, 5277 /*withElseRegion=*/true); 5278 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front()); 5279 if (resultType.isF80()) 5280 r1 = fir::runtime::genNearest(builder, loc, r, 5281 builder.createBool(loc, true)); 5282 else 5283 r1 = builder.create<mlir::arith::BitcastOp>( 5284 loc, resultType, 5285 builder.create<mlir::arith::SelectOp>(loc, aIsPositive, upResult, 5286 downResult)); 5287 builder.create<fir::ResultOp>(loc, r1); 5288 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front()); 5289 builder.create<fir::ResultOp>(loc, r); 5290 builder.setInsertionPointAfter(adjustIfOp); 5291 builder.create<fir::ResultOp>(loc, adjustIfOp.getResult(0)); 5292 5293 // Generate exceptions for (a < b) and (a > b) branches. 5294 builder.setInsertionPointAfter(ifOp2); 5295 r = ifOp2.getResult(0); 5296 fir::IfOp exceptIfOp1 = builder.create<fir::IfOp>( 5297 loc, genIsFPClass(i1Ty, r, infiniteTest), /*withElseRegion=*/true); 5298 builder.setInsertionPointToStart(&exceptIfOp1.getThenRegion().front()); 5299 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW | 5300 _FORTRAN_RUNTIME_IEEE_INEXACT); 5301 builder.setInsertionPointToStart(&exceptIfOp1.getElseRegion().front()); 5302 fir::IfOp exceptIfOp2 = builder.create<fir::IfOp>( 5303 loc, genIsFPClass(i1Ty, r, subnormalTest | zeroTest), 5304 /*withElseRegion=*/true); 5305 builder.setInsertionPointToStart(&exceptIfOp2.getThenRegion().front()); 5306 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW | 5307 _FORTRAN_RUNTIME_IEEE_INEXACT); 5308 builder.setInsertionPointToStart(&exceptIfOp2.getElseRegion().front()); 5309 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT); 5310 builder.setInsertionPointAfter(exceptIfOp1); 5311 builder.create<fir::ResultOp>(loc, ifOp2.getResult(0)); 5312 builder.setInsertionPointAfter(ifOp1); 5313 return ifOp1.getResult(0); 5314 } 5315 5316 // IEEE_REM 5317 mlir::Value IntrinsicLibrary::genIeeeRem(mlir::Type resultType, 5318 llvm::ArrayRef<mlir::Value> args) { 5319 // Return the remainder of X divided by Y. 5320 // Signal IEEE_UNDERFLOW if X is subnormal and Y is infinite. 5321 // Signal IEEE_INVALID if X is infinite or Y is zero and neither is a NaN. 5322 assert(args.size() == 2); 5323 mlir::Value x = args[0]; 5324 mlir::Value y = args[1]; 5325 if (mlir::dyn_cast<mlir::FloatType>(resultType).getWidth() < 32) { 5326 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext()); 5327 x = builder.create<fir::ConvertOp>(loc, f32Ty, x); 5328 y = builder.create<fir::ConvertOp>(loc, f32Ty, y); 5329 } else { 5330 x = builder.create<fir::ConvertOp>(loc, resultType, x); 5331 y = builder.create<fir::ConvertOp>(loc, resultType, y); 5332 } 5333 // remainder calls do not signal IEEE_UNDERFLOW. 5334 mlir::Value underflow = builder.create<mlir::arith::AndIOp>( 5335 loc, genIsFPClass(builder.getI1Type(), x, subnormalTest), 5336 genIsFPClass(builder.getI1Type(), y, infiniteTest)); 5337 mlir::Value result = genRuntimeCall("remainder", x.getType(), {x, y}); 5338 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW, underflow); 5339 return builder.create<fir::ConvertOp>(loc, resultType, result); 5340 } 5341 5342 // IEEE_RINT 5343 mlir::Value IntrinsicLibrary::genIeeeRint(mlir::Type resultType, 5344 llvm::ArrayRef<mlir::Value> args) { 5345 // Return the value of real argument A rounded to an integer value according 5346 // to argument ROUND if present, otherwise according to the current rounding 5347 // mode. If ROUND is not present, signal IEEE_INEXACT if A is not an exact 5348 // integral value. 5349 assert(args.size() == 2); 5350 mlir::Value a = args[0]; 5351 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder); 5352 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder); 5353 mlir::Value mode; 5354 if (isStaticallyPresent(args[1])) { 5355 mode = builder.create<fir::CallOp>(loc, getRound).getResult(0); 5356 genIeeeSetRoundingMode({args[1]}); 5357 } 5358 if (mlir::cast<mlir::FloatType>(resultType).getWidth() == 16) 5359 a = builder.create<fir::ConvertOp>( 5360 loc, mlir::Float32Type::get(builder.getContext()), a); 5361 mlir::Value result = builder.create<fir::ConvertOp>( 5362 loc, resultType, genRuntimeCall("nearbyint", a.getType(), a)); 5363 if (isStaticallyPresent(args[1])) { 5364 builder.create<fir::CallOp>(loc, setRound, mode); 5365 } else { 5366 mlir::Value inexact = builder.create<mlir::arith::CmpFOp>( 5367 loc, mlir::arith::CmpFPredicate::ONE, args[0], result); 5368 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact); 5369 } 5370 return result; 5371 } 5372 5373 // IEEE_SET_FLAG, IEEE_SET_HALTING_MODE 5374 template <bool isFlag> 5375 void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode( 5376 llvm::ArrayRef<fir::ExtendedValue> args) { 5377 // IEEE_SET_FLAG: Set an exception FLAG to a FLAG_VALUE. 5378 // IEEE_SET_HALTING: Set an exception halting mode FLAG to a HALTING value. 5379 assert(args.size() == 2); 5380 mlir::Type i1Ty = builder.getI1Type(); 5381 mlir::Type i32Ty = builder.getIntegerType(32); 5382 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0])); 5383 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef); 5384 mlir::Value except = fir::runtime::genMapExcept( 5385 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)); 5386 auto ifOp = builder.create<fir::IfOp>( 5387 loc, builder.create<fir::ConvertOp>(loc, i1Ty, getBase(args[1])), 5388 /*withElseRegion=*/true); 5389 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 5390 genRuntimeCall(isFlag ? "feraiseexcept" : "feenableexcept", i32Ty, except); 5391 builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 5392 genRuntimeCall(isFlag ? "feclearexcept" : "fedisableexcept", i32Ty, except); 5393 builder.setInsertionPointAfter(ifOp); 5394 } 5395 5396 // IEEE_SET_ROUNDING_MODE 5397 void IntrinsicLibrary::genIeeeSetRoundingMode( 5398 llvm::ArrayRef<fir::ExtendedValue> args) { 5399 // Set the current floating point rounding mode to the value of arg 5400 // ROUNDING_VALUE. Values are llvm.get.rounding encoding values. 5401 // Generate an error if the value of optional arg RADIX is not 2. 5402 assert(args.size() == 1 || args.size() == 2); 5403 if (args.size() == 2) 5404 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode"); 5405 auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[0])); 5406 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder); 5407 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef); 5408 mode = builder.create<fir::ConvertOp>( 5409 loc, setRound.getFunctionType().getInput(0), mode); 5410 builder.create<fir::CallOp>(loc, setRound, mode); 5411 } 5412 5413 // IEEE_SET_UNDERFLOW_MODE 5414 void IntrinsicLibrary::genIeeeSetUnderflowMode( 5415 llvm::ArrayRef<fir::ExtendedValue> args) { 5416 assert(args.size() == 1); 5417 mlir::Value gradual = builder.create<fir::ConvertOp>(loc, builder.getI1Type(), 5418 getBase(args[0])); 5419 fir::runtime::genSetUnderflowMode(builder, loc, {gradual}); 5420 } 5421 5422 // IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT, 5423 // IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE 5424 template <mlir::arith::CmpFPredicate pred> 5425 mlir::Value 5426 IntrinsicLibrary::genIeeeSignalingCompare(mlir::Type resultType, 5427 llvm::ArrayRef<mlir::Value> args) { 5428 // Compare X and Y with special case treatment of NaN operands. 5429 assert(args.size() == 2); 5430 mlir::Value hasNaNOp = genIeeeUnordered(mlir::Type{}, args); 5431 mlir::Value res = 5432 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]); 5433 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasNaNOp); 5434 return builder.create<fir::ConvertOp>(loc, resultType, res); 5435 } 5436 5437 // IEEE_SIGNBIT 5438 mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType, 5439 llvm::ArrayRef<mlir::Value> args) { 5440 // Check if the sign bit of arg X is set. 5441 assert(args.size() == 1); 5442 mlir::Value realVal = args[0]; 5443 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType()); 5444 int bitWidth = realType.getWidth(); 5445 if (realType == mlir::BFloat16Type::get(builder.getContext())) { 5446 // Workaround: can't bitcast or convert real(3) to integer(2) or real(2). 5447 realVal = builder.createConvert( 5448 loc, mlir::Float32Type::get(builder.getContext()), realVal); 5449 bitWidth = 32; 5450 } 5451 mlir::Type intType = builder.getIntegerType(bitWidth); 5452 mlir::Value intVal = 5453 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal); 5454 mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1); 5455 mlir::Value sign = builder.create<mlir::arith::ShRUIOp>(loc, intVal, shift); 5456 return builder.createConvert(loc, resultType, sign); 5457 } 5458 5459 // IEEE_SUPPORT_FLAG 5460 fir::ExtendedValue 5461 IntrinsicLibrary::genIeeeSupportFlag(mlir::Type resultType, 5462 llvm::ArrayRef<fir::ExtendedValue> args) { 5463 // Check if a floating point exception flag is supported. A flag is 5464 // supported either for all type kinds or none. An optional kind argument X 5465 // is therefore ignored. Standard flags are all supported. The nonstandard 5466 // DENORM extension is not supported, at least for now. 5467 assert(args.size() == 1 || args.size() == 2); 5468 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0])); 5469 mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef); 5470 mlir::Value mask = builder.createIntegerConstant( // values are powers of 2 5471 loc, fieldTy, 5472 _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO | 5473 _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW | 5474 _FORTRAN_RUNTIME_IEEE_INEXACT); 5475 return builder.createConvert( 5476 loc, resultType, 5477 builder.create<mlir::arith::CmpIOp>( 5478 loc, mlir::arith::CmpIPredicate::ne, 5479 builder.create<mlir::arith::AndIOp>(loc, flag, mask), 5480 builder.createIntegerConstant(loc, fieldTy, 0))); 5481 } 5482 5483 // IEEE_SUPPORT_HALTING 5484 fir::ExtendedValue IntrinsicLibrary::genIeeeSupportHalting( 5485 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) { 5486 // Check if halting is supported for a floating point exception flag. 5487 // Standard flags are all supported. The nonstandard DENORM extension is 5488 // not supported, at least for now. 5489 assert(args.size() == 1); 5490 mlir::Type i32Ty = builder.getIntegerType(32); 5491 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0])); 5492 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef); 5493 return builder.createConvert( 5494 loc, resultType, 5495 fir::runtime::genSupportHalting( 5496 builder, loc, {builder.create<fir::ConvertOp>(loc, i32Ty, field)})); 5497 } 5498 5499 // IEEE_SUPPORT_ROUNDING 5500 mlir::Value 5501 IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType, 5502 llvm::ArrayRef<mlir::Value> args) { 5503 // Check if floating point rounding mode ROUND_VALUE is supported. 5504 // Rounding is supported either for all type kinds or none. 5505 // An optional X kind argument is therefore ignored. 5506 // Values are chosen to match the llvm.get.rounding encoding: 5507 // 0 - toward zero [supported] 5508 // 1 - to nearest, ties to even [supported] - default 5509 // 2 - toward positive infinity [supported] 5510 // 3 - toward negative infinity [supported] 5511 // 4 - to nearest, ties away from zero [not supported] 5512 assert(args.size() == 1 || args.size() == 2); 5513 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, args[0]); 5514 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef); 5515 mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>( 5516 loc, mlir::arith::CmpIPredicate::sge, mode, 5517 builder.createIntegerConstant(loc, fieldTy, 5518 _FORTRAN_RUNTIME_IEEE_TO_ZERO)); 5519 mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>( 5520 loc, mlir::arith::CmpIPredicate::sle, mode, 5521 builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN)); 5522 return builder.createConvert( 5523 loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk)); 5524 } 5525 5526 // IEEE_UNORDERED 5527 mlir::Value 5528 IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType, 5529 llvm::ArrayRef<mlir::Value> args) { 5530 // Check if REAL args X or Y or both are (signaling or quiet) NaNs. 5531 // If there is no result type return an i1 result. 5532 assert(args.size() == 2); 5533 if (args[0].getType() == args[1].getType()) { 5534 mlir::Value res = builder.create<mlir::arith::CmpFOp>( 5535 loc, mlir::arith::CmpFPredicate::UNO, args[0], args[1]); 5536 return resultType ? builder.createConvert(loc, resultType, res) : res; 5537 } 5538 assert(resultType && "expecting a (mixed arg type) unordered result type"); 5539 mlir::Type i1Ty = builder.getI1Type(); 5540 mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], nanTest); 5541 mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], nanTest); 5542 mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan); 5543 return builder.createConvert(loc, resultType, res); 5544 } 5545 5546 // IEEE_VALUE 5547 mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType, 5548 llvm::ArrayRef<mlir::Value> args) { 5549 // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS. 5550 // A user call has two arguments: 5551 // - arg[0] is X (ignored, since the resultType is provided) 5552 // - arg[1] is CLASS, an IEEE_CLASS_TYPE CLASS argument containing an index 5553 // A compiler generated call has one argument: 5554 // - arg[0] is an index constant 5555 assert(args.size() == 1 || args.size() == 2); 5556 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(resultType); 5557 int bitWidth = realType.getWidth(); 5558 mlir::Type intType = builder.getIntegerType(bitWidth); 5559 mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64); 5560 constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1; 5561 mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy); 5562 std::string tableName = RTNAME_STRING(IeeeValueTable_) + 5563 std::to_string(realType.isBF16() ? 3 : bitWidth >> 3); 5564 if (!builder.getNamedGlobal(tableName)) { 5565 llvm::SmallVector<mlir::Attribute, tableSize> values; 5566 auto insert = [&](std::int64_t v) { 5567 values.push_back(builder.getIntegerAttr(valueTy, v)); 5568 }; 5569 insert(0); // placeholder 5570 switch (bitWidth) { 5571 case 16: 5572 if (realType.isF16()) { 5573 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits 5574 /* IEEE_SIGNALING_NAN */ insert(0x7d00); 5575 /* IEEE_QUIET_NAN */ insert(0x7e00); 5576 /* IEEE_NEGATIVE_INF */ insert(0xfc00); 5577 /* IEEE_NEGATIVE_NORMAL */ insert(0xbc00); 5578 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200); 5579 /* IEEE_NEGATIVE_ZERO */ insert(0x8000); 5580 /* IEEE_POSITIVE_ZERO */ insert(0x0000); 5581 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200); 5582 /* IEEE_POSITIVE_NORMAL */ insert(0x3c00); // 1.0 5583 /* IEEE_POSITIVE_INF */ insert(0x7c00); 5584 break; 5585 } 5586 assert(realType.isBF16() && "unknown 16-bit real type"); 5587 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits 5588 /* IEEE_SIGNALING_NAN */ insert(0x7fa0); 5589 /* IEEE_QUIET_NAN */ insert(0x7fc0); 5590 /* IEEE_NEGATIVE_INF */ insert(0xff80); 5591 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf80); 5592 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040); 5593 /* IEEE_NEGATIVE_ZERO */ insert(0x8000); 5594 /* IEEE_POSITIVE_ZERO */ insert(0x0000); 5595 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040); 5596 /* IEEE_POSITIVE_NORMAL */ insert(0x3f80); // 1.0 5597 /* IEEE_POSITIVE_INF */ insert(0x7f80); 5598 break; 5599 case 32: 5600 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits 5601 /* IEEE_SIGNALING_NAN */ insert(0x7fa00000); 5602 /* IEEE_QUIET_NAN */ insert(0x7fc00000); 5603 /* IEEE_NEGATIVE_INF */ insert(0xff800000); 5604 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf800000); 5605 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000); 5606 /* IEEE_NEGATIVE_ZERO */ insert(0x80000000); 5607 /* IEEE_POSITIVE_ZERO */ insert(0x00000000); 5608 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000); 5609 /* IEEE_POSITIVE_NORMAL */ insert(0x3f800000); // 1.0 5610 /* IEEE_POSITIVE_INF */ insert(0x7f800000); 5611 break; 5612 case 64: 5613 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits 5614 /* IEEE_SIGNALING_NAN */ insert(0x7ff4000000000000); 5615 /* IEEE_QUIET_NAN */ insert(0x7ff8000000000000); 5616 /* IEEE_NEGATIVE_INF */ insert(0xfff0000000000000); 5617 /* IEEE_NEGATIVE_NORMAL */ insert(0xbff0000000000000); 5618 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000); 5619 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000); 5620 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000); 5621 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000); 5622 /* IEEE_POSITIVE_NORMAL */ insert(0x3ff0000000000000); // 1.0 5623 /* IEEE_POSITIVE_INF */ insert(0x7ff0000000000000); 5624 break; 5625 case 80: 5626 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits 5627 // 64 high order bits; 16 low order bits are 0. 5628 /* IEEE_SIGNALING_NAN */ insert(0x7fffa00000000000); 5629 /* IEEE_QUIET_NAN */ insert(0x7fffc00000000000); 5630 /* IEEE_NEGATIVE_INF */ insert(0xffff800000000000); 5631 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff800000000000); 5632 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000); 5633 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000); 5634 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000); 5635 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000); 5636 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff800000000000); // 1.0 5637 /* IEEE_POSITIVE_INF */ insert(0x7fff800000000000); 5638 break; 5639 case 128: 5640 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits 5641 // 64 high order bits; 64 low order bits are 0. 5642 /* IEEE_SIGNALING_NAN */ insert(0x7fff400000000000); 5643 /* IEEE_QUIET_NAN */ insert(0x7fff800000000000); 5644 /* IEEE_NEGATIVE_INF */ insert(0xffff000000000000); 5645 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff000000000000); 5646 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000); 5647 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000); 5648 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000); 5649 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000); 5650 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff000000000000); // 1.0 5651 /* IEEE_POSITIVE_INF */ insert(0x7fff000000000000); 5652 break; 5653 default: 5654 llvm_unreachable("unknown real type"); 5655 } 5656 insert(0); // IEEE_OTHER_VALUE 5657 assert(values.size() == tableSize && "ieee value mismatch"); 5658 builder.createGlobalConstant( 5659 loc, tableTy, tableName, builder.createLinkOnceLinkage(), 5660 mlir::DenseElementsAttr::get( 5661 mlir::RankedTensorType::get(tableSize, valueTy), values)); 5662 } 5663 5664 mlir::Value which; 5665 if (args.size() == 2) { // user call 5666 auto [index, ignore] = getFieldRef(builder, loc, args[1]); 5667 which = builder.create<fir::LoadOp>(loc, index); 5668 } else { // compiler generated call 5669 which = args[0]; 5670 } 5671 mlir::Value bits = builder.create<fir::LoadOp>( 5672 loc, 5673 builder.create<fir::CoordinateOp>( 5674 loc, builder.getRefType(valueTy), 5675 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy), 5676 builder.getSymbolRefAttr(tableName)), 5677 which)); 5678 if (bitWidth > 64) 5679 bits = builder.create<mlir::arith::ShLIOp>( 5680 loc, builder.createConvert(loc, intType, bits), 5681 builder.createIntegerConstant(loc, intType, bitWidth - 64)); 5682 return builder.create<mlir::arith::BitcastOp>(loc, realType, bits); 5683 } 5684 5685 // IEOR 5686 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType, 5687 llvm::ArrayRef<mlir::Value> args) { 5688 assert(args.size() == 2); 5689 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0], 5690 args[1]); 5691 } 5692 5693 // INDEX 5694 fir::ExtendedValue 5695 IntrinsicLibrary::genIndex(mlir::Type resultType, 5696 llvm::ArrayRef<fir::ExtendedValue> args) { 5697 assert(args.size() >= 2 && args.size() <= 4); 5698 5699 mlir::Value stringBase = fir::getBase(args[0]); 5700 fir::KindTy kind = 5701 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind( 5702 stringBase.getType()); 5703 mlir::Value stringLen = fir::getLen(args[0]); 5704 mlir::Value substringBase = fir::getBase(args[1]); 5705 mlir::Value substringLen = fir::getLen(args[1]); 5706 mlir::Value back = 5707 isStaticallyAbsent(args, 2) 5708 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0) 5709 : fir::getBase(args[2]); 5710 if (isStaticallyAbsent(args, 3)) 5711 return builder.createConvert( 5712 loc, resultType, 5713 fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen, 5714 substringBase, substringLen, back)); 5715 5716 // Call the descriptor-based Index implementation 5717 mlir::Value string = builder.createBox(loc, args[0]); 5718 mlir::Value substring = builder.createBox(loc, args[1]); 5719 auto makeRefThenEmbox = [&](mlir::Value b) { 5720 fir::LogicalType logTy = fir::LogicalType::get( 5721 builder.getContext(), builder.getKindMap().defaultLogicalKind()); 5722 mlir::Value temp = builder.createTemporary(loc, logTy); 5723 mlir::Value castb = builder.createConvert(loc, logTy, b); 5724 builder.create<fir::StoreOp>(loc, castb, temp); 5725 return builder.createBox(loc, temp); 5726 }; 5727 mlir::Value backOpt = isStaticallyAbsent(args, 2) 5728 ? builder.create<fir::AbsentOp>( 5729 loc, fir::BoxType::get(builder.getI1Type())) 5730 : makeRefThenEmbox(fir::getBase(args[2])); 5731 mlir::Value kindVal = isStaticallyAbsent(args, 3) 5732 ? builder.createIntegerConstant( 5733 loc, builder.getIndexType(), 5734 builder.getKindMap().defaultIntegerKind()) 5735 : fir::getBase(args[3]); 5736 // Create mutable fir.box to be passed to the runtime for the result. 5737 fir::MutableBoxValue mutBox = 5738 fir::factory::createTempMutableBox(builder, loc, resultType); 5739 mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox); 5740 // Call runtime. The runtime is allocating the result. 5741 fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring, 5742 backOpt, kindVal); 5743 // Read back the result from the mutable box. 5744 return readAndAddCleanUp(mutBox, resultType, "INDEX"); 5745 } 5746 5747 // IOR 5748 mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType, 5749 llvm::ArrayRef<mlir::Value> args) { 5750 assert(args.size() == 2); 5751 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0], 5752 args[1]); 5753 } 5754 5755 // IPARITY 5756 fir::ExtendedValue 5757 IntrinsicLibrary::genIparity(mlir::Type resultType, 5758 llvm::ArrayRef<fir::ExtendedValue> args) { 5759 return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim, 5760 "IPARITY", resultType, args); 5761 } 5762 5763 // IS_CONTIGUOUS 5764 fir::ExtendedValue 5765 IntrinsicLibrary::genIsContiguous(mlir::Type resultType, 5766 llvm::ArrayRef<fir::ExtendedValue> args) { 5767 assert(args.size() == 1); 5768 return builder.createConvert( 5769 loc, resultType, 5770 fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0]))); 5771 } 5772 5773 // IS_IOSTAT_END, IS_IOSTAT_EOR 5774 template <Fortran::runtime::io::Iostat value> 5775 mlir::Value 5776 IntrinsicLibrary::genIsIostatValue(mlir::Type resultType, 5777 llvm::ArrayRef<mlir::Value> args) { 5778 assert(args.size() == 1); 5779 return builder.create<mlir::arith::CmpIOp>( 5780 loc, mlir::arith::CmpIPredicate::eq, args[0], 5781 builder.createIntegerConstant(loc, args[0].getType(), value)); 5782 } 5783 5784 // ISHFT 5785 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType, 5786 llvm::ArrayRef<mlir::Value> args) { 5787 // A conformant ISHFT(I,SHIFT) call satisfies: 5788 // abs(SHIFT) <= BIT_SIZE(I) 5789 // Return: abs(SHIFT) >= BIT_SIZE(I) 5790 // ? 0 5791 // : SHIFT < 0 5792 // ? I >> abs(SHIFT) 5793 // : I << abs(SHIFT) 5794 assert(args.size() == 2); 5795 int intWidth = resultType.getIntOrFloatBitWidth(); 5796 mlir::Type signlessType = 5797 mlir::IntegerType::get(builder.getContext(), intWidth, 5798 mlir::IntegerType::SignednessSemantics::Signless); 5799 mlir::Value bitSize = 5800 builder.createIntegerConstant(loc, signlessType, intWidth); 5801 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 5802 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]); 5803 mlir::Value absShift = genAbs(signlessType, {shift}); 5804 mlir::Value word = args[0]; 5805 if (word.getType().isUnsignedInteger()) 5806 word = builder.createConvert(loc, signlessType, word); 5807 auto left = builder.create<mlir::arith::ShLIOp>(loc, word, absShift); 5808 auto right = builder.create<mlir::arith::ShRUIOp>(loc, word, absShift); 5809 auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>( 5810 loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize); 5811 auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>( 5812 loc, mlir::arith::CmpIPredicate::slt, shift, zero); 5813 auto sel = 5814 builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left); 5815 mlir::Value result = 5816 builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel); 5817 if (resultType.isUnsignedInteger()) 5818 return builder.createConvert(loc, resultType, result); 5819 return result; 5820 } 5821 5822 // ISHFTC 5823 mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType, 5824 llvm::ArrayRef<mlir::Value> args) { 5825 // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies: 5826 // SIZE > 0 5827 // SIZE <= BIT_SIZE(I) 5828 // abs(SHIFT) <= SIZE 5829 // if SHIFT > 0 5830 // leftSize = abs(SHIFT) 5831 // rightSize = SIZE - abs(SHIFT) 5832 // else [if SHIFT < 0] 5833 // leftSize = SIZE - abs(SHIFT) 5834 // rightSize = abs(SHIFT) 5835 // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE 5836 // leftMaskShift = BIT_SIZE(I) - leftSize 5837 // rightMaskShift = BIT_SIZE(I) - rightSize 5838 // left = (I >> rightSize) & (-1 >> leftMaskShift) 5839 // right = (I & (-1 >> rightMaskShift)) << leftSize 5840 // Return: SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right) 5841 assert(args.size() == 3); 5842 int intWidth = resultType.getIntOrFloatBitWidth(); 5843 mlir::Type signlessType = 5844 mlir::IntegerType::get(builder.getContext(), intWidth, 5845 mlir::IntegerType::SignednessSemantics::Signless); 5846 mlir::Value bitSize = 5847 builder.createIntegerConstant(loc, signlessType, intWidth); 5848 mlir::Value word = args[0]; 5849 if (word.getType().isUnsignedInteger()) 5850 word = builder.createConvert(loc, signlessType, word); 5851 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]); 5852 mlir::Value size = 5853 args[2] ? builder.createConvert(loc, signlessType, args[2]) : bitSize; 5854 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 5855 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 5856 mlir::Value absShift = genAbs(signlessType, {shift}); 5857 auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift); 5858 auto shiftIsZero = builder.create<mlir::arith::CmpIOp>( 5859 loc, mlir::arith::CmpIPredicate::eq, shift, zero); 5860 auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>( 5861 loc, mlir::arith::CmpIPredicate::eq, absShift, size); 5862 auto shiftIsNop = 5863 builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize); 5864 auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>( 5865 loc, mlir::arith::CmpIPredicate::sgt, shift, zero); 5866 auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive, 5867 absShift, elseSize); 5868 auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive, 5869 elseSize, absShift); 5870 auto hasUnchanged = builder.create<mlir::arith::CmpIOp>( 5871 loc, mlir::arith::CmpIPredicate::ne, size, bitSize); 5872 auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, word, size); 5873 auto unchangedTmp2 = 5874 builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size); 5875 auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged, 5876 unchangedTmp2, zero); 5877 auto leftMaskShift = 5878 builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize); 5879 auto leftMask = 5880 builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift); 5881 auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, word, rightSize); 5882 auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask); 5883 auto rightMaskShift = 5884 builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize); 5885 auto rightMask = 5886 builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift); 5887 auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, word, rightMask); 5888 auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize); 5889 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left); 5890 auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right); 5891 mlir::Value result = 5892 builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, word, res); 5893 if (resultType.isUnsignedInteger()) 5894 return builder.createConvert(loc, resultType, result); 5895 return result; 5896 } 5897 5898 // LEADZ 5899 mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType, 5900 llvm::ArrayRef<mlir::Value> args) { 5901 assert(args.size() == 1); 5902 5903 mlir::Value result = 5904 builder.create<mlir::math::CountLeadingZerosOp>(loc, args); 5905 5906 return builder.createConvert(loc, resultType, result); 5907 } 5908 5909 // LEN 5910 // Note that this is only used for an unrestricted intrinsic LEN call. 5911 // Other uses of LEN are rewritten as descriptor inquiries by the front-end. 5912 fir::ExtendedValue 5913 IntrinsicLibrary::genLen(mlir::Type resultType, 5914 llvm::ArrayRef<fir::ExtendedValue> args) { 5915 // Optional KIND argument reflected in result type and otherwise ignored. 5916 assert(args.size() == 1 || args.size() == 2); 5917 mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]); 5918 return builder.createConvert(loc, resultType, len); 5919 } 5920 5921 // LEN_TRIM 5922 fir::ExtendedValue 5923 IntrinsicLibrary::genLenTrim(mlir::Type resultType, 5924 llvm::ArrayRef<fir::ExtendedValue> args) { 5925 // Optional KIND argument reflected in result type and otherwise ignored. 5926 assert(args.size() == 1 || args.size() == 2); 5927 const fir::CharBoxValue *charBox = args[0].getCharBox(); 5928 if (!charBox) 5929 TODO(loc, "intrinsic: len_trim for character array"); 5930 auto len = 5931 fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox); 5932 return builder.createConvert(loc, resultType, len); 5933 } 5934 5935 // LGE, LGT, LLE, LLT 5936 template <mlir::arith::CmpIPredicate pred> 5937 fir::ExtendedValue 5938 IntrinsicLibrary::genCharacterCompare(mlir::Type resultType, 5939 llvm::ArrayRef<fir::ExtendedValue> args) { 5940 assert(args.size() == 2); 5941 return fir::runtime::genCharCompare( 5942 builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]), 5943 fir::getBase(args[1]), fir::getLen(args[1])); 5944 } 5945 5946 static bool isOptional(mlir::Value value) { 5947 auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>( 5948 value.getDefiningOp()); 5949 return varIface && varIface.isOptional(); 5950 } 5951 5952 // LOC 5953 fir::ExtendedValue 5954 IntrinsicLibrary::genLoc(mlir::Type resultType, 5955 llvm::ArrayRef<fir::ExtendedValue> args) { 5956 assert(args.size() == 1); 5957 mlir::Value box = fir::getBase(args[0]); 5958 assert(fir::isa_box_type(box.getType()) && 5959 "argument must have been lowered to box type"); 5960 bool isFunc = mlir::isa<fir::BoxProcType>(box.getType()); 5961 if (!isOptional(box)) { 5962 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc); 5963 return builder.createConvert(loc, resultType, argAddr); 5964 } 5965 // Optional assumed shape case. Although this is not specified in this GNU 5966 // intrinsic extension, LOC accepts absent optional and returns zero in that 5967 // case. 5968 // Note that the other OPTIONAL cases do not fall here since `box` was 5969 // created when preparing the argument cases, but the box can be safely be 5970 // used for all those cases and the address will be null if absent. 5971 mlir::Value isPresent = 5972 builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), box); 5973 return builder 5974 .genIfOp(loc, {resultType}, isPresent, 5975 /*withElseRegion=*/true) 5976 .genThen([&]() { 5977 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc); 5978 mlir::Value cast = builder.createConvert(loc, resultType, argAddr); 5979 builder.create<fir::ResultOp>(loc, cast); 5980 }) 5981 .genElse([&]() { 5982 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0); 5983 builder.create<fir::ResultOp>(loc, zero); 5984 }) 5985 .getResults()[0]; 5986 } 5987 5988 mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType, 5989 llvm::ArrayRef<mlir::Value> args) { 5990 assert(args.size() == 1); 5991 return builder.createConvert(loc, resultType, 5992 fir::runtime::genMalloc(builder, loc, args[0])); 5993 } 5994 5995 // MASKL, MASKR, UMASKL, UMASKR 5996 template <typename Shift> 5997 mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType, 5998 llvm::ArrayRef<mlir::Value> args) { 5999 assert(args.size() == 2); 6000 6001 int bits = resultType.getIntOrFloatBitWidth(); 6002 mlir::Type signlessType = 6003 mlir::IntegerType::get(builder.getContext(), bits, 6004 mlir::IntegerType::SignednessSemantics::Signless); 6005 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 6006 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 6007 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits); 6008 mlir::Value bitsToSet = builder.createConvert(loc, signlessType, args[0]); 6009 6010 // The standard does not specify what to return if the number of bits to be 6011 // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will 6012 // produce a poison value which may return a possibly platform-specific and/or 6013 // non-deterministic result. Other compilers don't produce a consistent result 6014 // in this case either, so we choose the most efficient implementation. 6015 mlir::Value shift = 6016 builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet); 6017 mlir::Value shifted = builder.create<Shift>(loc, ones, shift); 6018 mlir::Value isZero = builder.create<mlir::arith::CmpIOp>( 6019 loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero); 6020 mlir::Value result = 6021 builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted); 6022 if (resultType.isUnsignedInteger()) 6023 return builder.createConvert(loc, resultType, result); 6024 return result; 6025 } 6026 6027 // MATMUL 6028 fir::ExtendedValue 6029 IntrinsicLibrary::genMatmul(mlir::Type resultType, 6030 llvm::ArrayRef<fir::ExtendedValue> args) { 6031 assert(args.size() == 2); 6032 6033 // Handle required matmul arguments 6034 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]); 6035 mlir::Value matrixA = fir::getBase(matrixTmpA); 6036 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]); 6037 mlir::Value matrixB = fir::getBase(matrixTmpB); 6038 unsigned resultRank = 6039 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2; 6040 6041 // Create mutable fir.box to be passed to the runtime for the result. 6042 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank); 6043 fir::MutableBoxValue resultMutableBox = 6044 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 6045 mlir::Value resultIrBox = 6046 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6047 // Call runtime. The runtime is allocating the result. 6048 fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB); 6049 // Read result from mutable fir.box and add it to the list of temps to be 6050 // finalized by the StatementContext. 6051 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL"); 6052 } 6053 6054 // MATMUL_TRANSPOSE 6055 fir::ExtendedValue 6056 IntrinsicLibrary::genMatmulTranspose(mlir::Type resultType, 6057 llvm::ArrayRef<fir::ExtendedValue> args) { 6058 assert(args.size() == 2); 6059 6060 // Handle required matmul_transpose arguments 6061 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]); 6062 mlir::Value matrixA = fir::getBase(matrixTmpA); 6063 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]); 6064 mlir::Value matrixB = fir::getBase(matrixTmpB); 6065 unsigned resultRank = 6066 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2; 6067 6068 // Create mutable fir.box to be passed to the runtime for the result. 6069 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank); 6070 fir::MutableBoxValue resultMutableBox = 6071 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 6072 mlir::Value resultIrBox = 6073 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6074 // Call runtime. The runtime is allocating the result. 6075 fir::runtime::genMatmulTranspose(builder, loc, resultIrBox, matrixA, matrixB); 6076 // Read result from mutable fir.box and add it to the list of temps to be 6077 // finalized by the StatementContext. 6078 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL_TRANSPOSE"); 6079 } 6080 6081 // MERGE 6082 fir::ExtendedValue 6083 IntrinsicLibrary::genMerge(mlir::Type, 6084 llvm::ArrayRef<fir::ExtendedValue> args) { 6085 assert(args.size() == 3); 6086 mlir::Value tsource = fir::getBase(args[0]); 6087 mlir::Value fsource = fir::getBase(args[1]); 6088 mlir::Value rawMask = fir::getBase(args[2]); 6089 mlir::Type type0 = fir::unwrapRefType(tsource.getType()); 6090 bool isCharRslt = fir::isa_char(type0); // result is same as first argument 6091 mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask); 6092 6093 // The result is polymorphic if and only if both TSOURCE and FSOURCE are 6094 // polymorphic. TSOURCE and FSOURCE are required to have the same type 6095 // (for both declared and dynamic types) so a simple convert op can be 6096 // used. 6097 mlir::Value tsourceCast = tsource; 6098 mlir::Value fsourceCast = fsource; 6099 auto convertToStaticType = [&](mlir::Value polymorphic, 6100 mlir::Value other) -> mlir::Value { 6101 mlir::Type otherType = other.getType(); 6102 if (mlir::isa<fir::BaseBoxType>(otherType)) 6103 return builder.create<fir::ReboxOp>(loc, otherType, polymorphic, 6104 /*shape*/ mlir::Value{}, 6105 /*slice=*/mlir::Value{}); 6106 return builder.create<fir::BoxAddrOp>(loc, otherType, polymorphic); 6107 }; 6108 if (fir::isPolymorphicType(tsource.getType()) && 6109 !fir::isPolymorphicType(fsource.getType())) { 6110 tsourceCast = convertToStaticType(tsource, fsource); 6111 } else if (!fir::isPolymorphicType(tsource.getType()) && 6112 fir::isPolymorphicType(fsource.getType())) { 6113 fsourceCast = convertToStaticType(fsource, tsource); 6114 } else { 6115 // FSOURCE and TSOURCE are not polymorphic. 6116 // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR 6117 // types (one can have dynamic length while the other has constant lengths, 6118 // or one may be a fir.logical<> while the other is an i1). Insert a cast to 6119 // fulfill mlir::SelectOp constraint that the MLIR types must be the same. 6120 fsourceCast = builder.createConvert(loc, tsource.getType(), fsource); 6121 } 6122 auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, tsourceCast, 6123 fsourceCast); 6124 if (isCharRslt) { 6125 // Need a CharBoxValue for character results 6126 const fir::CharBoxValue *charBox = args[0].getCharBox(); 6127 fir::CharBoxValue charRslt(rslt, charBox->getLen()); 6128 return charRslt; 6129 } 6130 return rslt; 6131 } 6132 6133 // MERGE_BITS 6134 mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType, 6135 llvm::ArrayRef<mlir::Value> args) { 6136 assert(args.size() == 3); 6137 6138 mlir::Type signlessType = mlir::IntegerType::get( 6139 builder.getContext(), resultType.getIntOrFloatBitWidth(), 6140 mlir::IntegerType::SignednessSemantics::Signless); 6141 // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK))) 6142 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 6143 mlir::Value notMask = builder.createUnsigned<mlir::arith::XOrIOp>( 6144 loc, resultType, args[2], ones); 6145 mlir::Value lft = builder.createUnsigned<mlir::arith::AndIOp>( 6146 loc, resultType, args[0], args[2]); 6147 mlir::Value rgt = builder.createUnsigned<mlir::arith::AndIOp>( 6148 loc, resultType, args[1], notMask); 6149 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, lft, rgt); 6150 } 6151 6152 // MOD 6153 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType, 6154 llvm::ArrayRef<mlir::Value> args) { 6155 assert(args.size() == 2); 6156 if (resultType.isUnsignedInteger()) { 6157 mlir::Type signlessType = mlir::IntegerType::get( 6158 builder.getContext(), resultType.getIntOrFloatBitWidth(), 6159 mlir::IntegerType::SignednessSemantics::Signless); 6160 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType, 6161 args[0], args[1]); 6162 } 6163 if (mlir::isa<mlir::IntegerType>(resultType)) 6164 return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]); 6165 6166 // Use runtime. 6167 return builder.createConvert( 6168 loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1])); 6169 } 6170 6171 // MODULO 6172 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType, 6173 llvm::ArrayRef<mlir::Value> args) { 6174 // TODO: we'd better generate a runtime call here, when runtime error 6175 // checking is needed (to detect 0 divisor) or when precise math is requested. 6176 assert(args.size() == 2); 6177 // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR. 6178 // In the meantime, use a simple inlined implementation based on truncated 6179 // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual 6180 // division and multiplication from MODULO formula. 6181 // - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD. 6182 // - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) = 6183 // A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P 6184 // Note that A/P < 0 if and only if A and P signs are different. 6185 if (resultType.isUnsignedInteger()) { 6186 mlir::Type signlessType = mlir::IntegerType::get( 6187 builder.getContext(), resultType.getIntOrFloatBitWidth(), 6188 mlir::IntegerType::SignednessSemantics::Signless); 6189 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType, 6190 args[0], args[1]); 6191 } 6192 if (mlir::isa<mlir::IntegerType>(resultType)) { 6193 auto remainder = 6194 builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]); 6195 auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]); 6196 mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0); 6197 auto argSignDifferent = builder.create<mlir::arith::CmpIOp>( 6198 loc, mlir::arith::CmpIPredicate::slt, argXor, zero); 6199 auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>( 6200 loc, mlir::arith::CmpIPredicate::ne, remainder, zero); 6201 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero, 6202 argSignDifferent); 6203 auto remPlusP = 6204 builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]); 6205 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP, 6206 remainder); 6207 } 6208 6209 auto fastMathFlags = builder.getFastMathFlags(); 6210 // F128 arith::RemFOp may be lowered to a runtime call that may be unsupported 6211 // on the target, so generate a call to Fortran Runtime's ModuloReal16. 6212 if (resultType == mlir::Float128Type::get(builder.getContext()) || 6213 (fastMathFlags & mlir::arith::FastMathFlags::ninf) == 6214 mlir::arith::FastMathFlags::none) 6215 return builder.createConvert( 6216 loc, resultType, 6217 fir::runtime::genModulo(builder, loc, args[0], args[1])); 6218 6219 auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]); 6220 mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType()); 6221 auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>( 6222 loc, mlir::arith::CmpFPredicate::UNE, remainder, zero); 6223 auto aLessThanZero = builder.create<mlir::arith::CmpFOp>( 6224 loc, mlir::arith::CmpFPredicate::OLT, args[0], zero); 6225 auto pLessThanZero = builder.create<mlir::arith::CmpFOp>( 6226 loc, mlir::arith::CmpFPredicate::OLT, args[1], zero); 6227 auto argSignDifferent = 6228 builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero); 6229 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero, 6230 argSignDifferent); 6231 auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]); 6232 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP, 6233 remainder); 6234 } 6235 6236 void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue> args) { 6237 assert(args.size() == 4); 6238 6239 const fir::ExtendedValue &from = args[0]; 6240 const fir::ExtendedValue &to = args[1]; 6241 const fir::ExtendedValue &status = args[2]; 6242 const fir::ExtendedValue &errMsg = args[3]; 6243 6244 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 6245 mlir::Value errBox = 6246 isStaticallyPresent(errMsg) 6247 ? fir::getBase(errMsg) 6248 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 6249 6250 const fir::MutableBoxValue *fromBox = from.getBoxOf<fir::MutableBoxValue>(); 6251 const fir::MutableBoxValue *toBox = to.getBoxOf<fir::MutableBoxValue>(); 6252 6253 assert(fromBox && toBox && "move_alloc parameters must be mutable arrays"); 6254 6255 mlir::Value fromAddr = fir::factory::getMutableIRBox(builder, loc, *fromBox); 6256 mlir::Value toAddr = fir::factory::getMutableIRBox(builder, loc, *toBox); 6257 6258 mlir::Value hasStat = builder.createBool(loc, isStaticallyPresent(status)); 6259 6260 mlir::Value stat = fir::runtime::genMoveAlloc(builder, loc, toAddr, fromAddr, 6261 hasStat, errBox); 6262 6263 fir::factory::syncMutableBoxFromIRBox(builder, loc, *fromBox); 6264 fir::factory::syncMutableBoxFromIRBox(builder, loc, *toBox); 6265 6266 if (isStaticallyPresent(status)) { 6267 mlir::Value statAddr = fir::getBase(status); 6268 mlir::Value statIsPresentAtRuntime = 6269 builder.genIsNotNullAddr(loc, statAddr); 6270 builder.genIfThen(loc, statIsPresentAtRuntime) 6271 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) 6272 .end(); 6273 } 6274 } 6275 6276 // MVBITS 6277 void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) { 6278 // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies: 6279 // FROMPOS >= 0 6280 // LEN >= 0 6281 // TOPOS >= 0 6282 // FROMPOS + LEN <= BIT_SIZE(FROM) 6283 // TOPOS + LEN <= BIT_SIZE(TO) 6284 // MASK = -1 >> (BIT_SIZE(FROM) - LEN) 6285 // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) | 6286 // (((FROM >> FROMPOS) & MASK) << TOPOS) 6287 assert(args.size() == 5); 6288 auto unbox = [&](fir::ExtendedValue exv) { 6289 const mlir::Value *arg = exv.getUnboxed(); 6290 assert(arg && "nonscalar mvbits argument"); 6291 return *arg; 6292 }; 6293 mlir::Value from = unbox(args[0]); 6294 mlir::Type fromType = from.getType(); 6295 mlir::Type signlessType = mlir::IntegerType::get( 6296 builder.getContext(), fromType.getIntOrFloatBitWidth(), 6297 mlir::IntegerType::SignednessSemantics::Signless); 6298 mlir::Value frompos = 6299 builder.createConvert(loc, signlessType, unbox(args[1])); 6300 mlir::Value len = builder.createConvert(loc, signlessType, unbox(args[2])); 6301 mlir::Value toAddr = unbox(args[3]); 6302 mlir::Type toType{fir::dyn_cast_ptrEleTy(toAddr.getType())}; 6303 assert(toType.getIntOrFloatBitWidth() == fromType.getIntOrFloatBitWidth() && 6304 "mismatched mvbits types"); 6305 auto to = builder.create<fir::LoadOp>(loc, signlessType, toAddr); 6306 mlir::Value topos = builder.createConvert(loc, signlessType, unbox(args[4])); 6307 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 6308 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType); 6309 mlir::Value bitSize = builder.createIntegerConstant( 6310 loc, signlessType, 6311 mlir::cast<mlir::IntegerType>(signlessType).getWidth()); 6312 auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len); 6313 auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount); 6314 auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos); 6315 auto unchangedTmp2 = 6316 builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones); 6317 auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to); 6318 if (fromType.isUnsignedInteger()) 6319 from = builder.createConvert(loc, signlessType, from); 6320 auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos); 6321 auto frombitsTmp2 = 6322 builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask); 6323 auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos); 6324 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits); 6325 auto lenIsZero = builder.create<mlir::arith::CmpIOp>( 6326 loc, mlir::arith::CmpIPredicate::eq, len, zero); 6327 mlir::Value res = 6328 builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp); 6329 if (toType.isUnsignedInteger()) 6330 res = builder.createConvert(loc, toType, res); 6331 builder.create<fir::StoreOp>(loc, res, toAddr); 6332 } 6333 6334 // NEAREST, IEEE_NEXT_AFTER, IEEE_NEXT_DOWN, IEEE_NEXT_UP 6335 template <I::NearestProc proc> 6336 mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType, 6337 llvm::ArrayRef<mlir::Value> args) { 6338 // NEAREST 6339 // Return the number adjacent to arg X in the direction of the infinity 6340 // with the sign of arg S. Terminate with an error if arg S is zero. 6341 // Generate exceptions as for IEEE_NEXT_AFTER. 6342 // IEEE_NEXT_AFTER 6343 // Return isNan(Y) ? NaN : X==Y ? X : num adjacent to X in the dir of Y. 6344 // Signal IEEE_OVERFLOW, IEEE_INEXACT for finite X and infinite result. 6345 // Signal IEEE_UNDERFLOW, IEEE_INEXACT for subnormal result. 6346 // IEEE_NEXT_DOWN 6347 // Return the number adjacent to X and less than X. 6348 // Signal IEEE_INVALID when X is a signaling NaN. 6349 // IEEE_NEXT_UP 6350 // Return the number adjacent to X and greater than X. 6351 // Signal IEEE_INVALID when X is a signaling NaN. 6352 // 6353 // valueUp -- true if a finite result must be larger than X. 6354 // magnitudeUp -- true if a finite abs(result) must be larger than abs(X). 6355 // 6356 // if (isNextAfter && isNan(Y)) X = NaN // result = NaN 6357 // if (isNan(X) || (isNextAfter && X == Y) || (isInfinite(X) && magnitudeUp)) 6358 // result = X 6359 // else if (isZero(X)) 6360 // result = valueUp ? minPositiveSubnormal : minNegativeSubnormal 6361 // else 6362 // result = magUp ? (X + minPositiveSubnormal) : (X - minPositiveSubnormal) 6363 6364 assert(args.size() == 1 || args.size() == 2); 6365 mlir::Value x = args[0]; 6366 mlir::FloatType xType = mlir::dyn_cast<mlir::FloatType>(x.getType()); 6367 const unsigned xBitWidth = xType.getWidth(); 6368 mlir::Type i1Ty = builder.getI1Type(); 6369 if constexpr (proc == NearestProc::NextAfter) 6370 // If isNan(Y), set X to a qNaN that will propagate to the resultIsX result. 6371 x = builder.create<mlir::arith::SelectOp>( 6372 loc, genIsFPClass(i1Ty, args[1], nanTest), genQNan(xType), x); 6373 mlir::Value resultIsX = genIsFPClass(i1Ty, x, nanTest); 6374 mlir::Type intType = builder.getIntegerType(xBitWidth); 6375 mlir::Value one = builder.createIntegerConstant(loc, intType, 1); 6376 6377 // Set valueUp to true if a finite result must be larger than arg X. 6378 mlir::Value valueUp; 6379 if constexpr (proc == NearestProc::Nearest) { 6380 // Arg S must not be zero. 6381 fir::IfOp ifOp = 6382 builder.create<fir::IfOp>(loc, genIsFPClass(i1Ty, args[1], zeroTest), 6383 /*withElseRegion=*/false); 6384 builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 6385 fir::runtime::genReportFatalUserError( 6386 builder, loc, "intrinsic nearest S argument is zero"); 6387 builder.setInsertionPointAfter(ifOp); 6388 mlir::Value sSign = IntrinsicLibrary::genIeeeSignbit(intType, {args[1]}); 6389 valueUp = builder.create<mlir::arith::CmpIOp>( 6390 loc, mlir::arith::CmpIPredicate::ne, sSign, one); 6391 } else if constexpr (proc == NearestProc::NextAfter) { 6392 // Convert X and Y to a common type to allow comparison. Direct conversions 6393 // between kinds 2, 3, 10, and 16 are not all supported. These conversions 6394 // are implemented by converting kind=2,3 values to kind=4, possibly 6395 // followed with a conversion of that value to a larger type. 6396 mlir::Value x1 = x; 6397 mlir::Value y = args[1]; 6398 mlir::FloatType yType = mlir::dyn_cast<mlir::FloatType>(args[1].getType()); 6399 const unsigned yBitWidth = yType.getWidth(); 6400 if (xType != yType) { 6401 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext()); 6402 if (xBitWidth < 32) 6403 x1 = builder.createConvert(loc, f32Ty, x1); 6404 if (yBitWidth > 32 && yBitWidth > xBitWidth) 6405 x1 = builder.createConvert(loc, yType, x1); 6406 if (yBitWidth < 32) 6407 y = builder.createConvert(loc, f32Ty, y); 6408 if (xBitWidth > 32 && xBitWidth > yBitWidth) 6409 y = builder.createConvert(loc, xType, y); 6410 } 6411 resultIsX = builder.create<mlir::arith::OrIOp>( 6412 loc, resultIsX, 6413 builder.create<mlir::arith::CmpFOp>( 6414 loc, mlir::arith::CmpFPredicate::OEQ, x1, y)); 6415 valueUp = builder.create<mlir::arith::CmpFOp>( 6416 loc, mlir::arith::CmpFPredicate::OLT, x1, y); 6417 } else if constexpr (proc == NearestProc::NextDown) { 6418 valueUp = builder.createBool(loc, false); 6419 } else if constexpr (proc == NearestProc::NextUp) { 6420 valueUp = builder.createBool(loc, true); 6421 } 6422 mlir::Value magnitudeUp = builder.create<mlir::arith::CmpIOp>( 6423 loc, mlir::arith::CmpIPredicate::ne, valueUp, 6424 IntrinsicLibrary::genIeeeSignbit(i1Ty, {args[0]})); 6425 resultIsX = builder.create<mlir::arith::OrIOp>( 6426 loc, resultIsX, 6427 builder.create<mlir::arith::AndIOp>( 6428 loc, genIsFPClass(i1Ty, x, infiniteTest), magnitudeUp)); 6429 6430 // Result is X. (For ieee_next_after with isNan(Y), X has been set to a NaN.) 6431 fir::IfOp outerIfOp = builder.create<fir::IfOp>(loc, resultType, resultIsX, 6432 /*withElseRegion=*/true); 6433 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front()); 6434 if constexpr (proc == NearestProc::NextDown || proc == NearestProc::NextUp) 6435 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, 6436 genIsFPClass(i1Ty, x, snanTest)); 6437 builder.create<fir::ResultOp>(loc, x); 6438 6439 // Result is minPositiveSubnormal or minNegativeSubnormal. (X is zero.) 6440 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front()); 6441 mlir::Value resultIsMinSubnormal = builder.create<mlir::arith::CmpFOp>( 6442 loc, mlir::arith::CmpFPredicate::OEQ, x, 6443 builder.createRealZeroConstant(loc, xType)); 6444 fir::IfOp innerIfOp = 6445 builder.create<fir::IfOp>(loc, resultType, resultIsMinSubnormal, 6446 /*withElseRegion=*/true); 6447 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front()); 6448 mlir::Value minPositiveSubnormal = 6449 builder.create<mlir::arith::BitcastOp>(loc, resultType, one); 6450 mlir::Value minNegativeSubnormal = builder.create<mlir::arith::BitcastOp>( 6451 loc, resultType, 6452 builder.create<mlir::arith::ConstantOp>( 6453 loc, intType, 6454 builder.getIntegerAttr( 6455 intType, llvm::APInt::getBitsSetWithWrap( 6456 xBitWidth, /*lo=*/xBitWidth - 1, /*hi=*/1)))); 6457 mlir::Value result = builder.create<mlir::arith::SelectOp>( 6458 loc, valueUp, minPositiveSubnormal, minNegativeSubnormal); 6459 if constexpr (proc == NearestProc::Nearest || proc == NearestProc::NextAfter) 6460 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW | 6461 _FORTRAN_RUNTIME_IEEE_INEXACT); 6462 builder.create<fir::ResultOp>(loc, result); 6463 6464 // Result is (X + minPositiveSubnormal) or (X - minPositiveSubnormal). 6465 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front()); 6466 if (xBitWidth == 80) { 6467 // Kind 10. Call std::nextafter, which generates exceptions as required 6468 // for ieee_next_after and nearest. Override this exception processing 6469 // for ieee_next_down and ieee_next_up. 6470 constexpr bool overrideExceptionGeneration = 6471 proc == NearestProc::NextDown || proc == NearestProc::NextUp; 6472 [[maybe_unused]] mlir::Type i32Ty; 6473 [[maybe_unused]] mlir::Value allExcepts, excepts, mask; 6474 if constexpr (overrideExceptionGeneration) { 6475 i32Ty = builder.getIntegerType(32); 6476 allExcepts = fir::runtime::genMapExcept( 6477 builder, loc, 6478 builder.createIntegerConstant(loc, i32Ty, _FORTRAN_RUNTIME_IEEE_ALL)); 6479 excepts = genRuntimeCall("fetestexcept", i32Ty, allExcepts); 6480 mask = genRuntimeCall("fedisableexcept", i32Ty, allExcepts); 6481 } 6482 result = fir::runtime::genNearest(builder, loc, x, valueUp); 6483 if constexpr (overrideExceptionGeneration) { 6484 genRuntimeCall("feclearexcept", i32Ty, allExcepts); 6485 genRuntimeCall("feraiseexcept", i32Ty, excepts); 6486 genRuntimeCall("feenableexcept", i32Ty, mask); 6487 } 6488 builder.create<fir::ResultOp>(loc, result); 6489 } else { 6490 // Kind 2, 3, 4, 8, 16. Increment or decrement X cast to integer. 6491 mlir::Value intX = builder.create<mlir::arith::BitcastOp>(loc, intType, x); 6492 result = builder.create<mlir::arith::BitcastOp>( 6493 loc, resultType, 6494 builder.create<mlir::arith::SelectOp>( 6495 loc, magnitudeUp, 6496 builder.create<mlir::arith::AddIOp>(loc, intX, one), 6497 builder.create<mlir::arith::SubIOp>(loc, intX, one))); 6498 if constexpr (proc == NearestProc::Nearest || 6499 proc == NearestProc::NextAfter) { 6500 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW | 6501 _FORTRAN_RUNTIME_IEEE_INEXACT, 6502 genIsFPClass(i1Ty, result, infiniteTest)); 6503 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW | 6504 _FORTRAN_RUNTIME_IEEE_INEXACT, 6505 genIsFPClass(i1Ty, result, subnormalTest)); 6506 } 6507 builder.create<fir::ResultOp>(loc, result); 6508 } 6509 6510 builder.setInsertionPointAfter(innerIfOp); 6511 builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0)); 6512 builder.setInsertionPointAfter(outerIfOp); 6513 return outerIfOp.getResult(0); 6514 } 6515 6516 // NINT 6517 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType, 6518 llvm::ArrayRef<mlir::Value> args) { 6519 assert(args.size() >= 1); 6520 // Skip optional kind argument to search the runtime; it is already reflected 6521 // in result type. 6522 return genRuntimeCall("nint", resultType, {args[0]}); 6523 } 6524 6525 // NORM2 6526 fir::ExtendedValue 6527 IntrinsicLibrary::genNorm2(mlir::Type resultType, 6528 llvm::ArrayRef<fir::ExtendedValue> args) { 6529 assert(args.size() == 2); 6530 6531 // Handle required array argument 6532 mlir::Value array = builder.createBox(loc, args[0]); 6533 unsigned rank = fir::BoxValue(array).rank(); 6534 assert(rank >= 1); 6535 6536 // Check if the dim argument is present 6537 bool absentDim = isStaticallyAbsent(args[1]); 6538 6539 // If dim argument is absent or the array is rank 1, then the result is 6540 // a scalar (since the the result is rank-1 or 0). Otherwise, the result is 6541 // an array. 6542 if (absentDim || rank == 1) { 6543 return fir::runtime::genNorm2(builder, loc, array); 6544 } else { 6545 // Create mutable fir.box to be passed to the runtime for the result. 6546 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 6547 fir::MutableBoxValue resultMutableBox = 6548 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 6549 mlir::Value resultIrBox = 6550 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6551 6552 mlir::Value dim = fir::getBase(args[1]); 6553 fir::runtime::genNorm2Dim(builder, loc, resultIrBox, array, dim); 6554 // Handle cleanup of allocatable result descriptor and return 6555 return readAndAddCleanUp(resultMutableBox, resultType, "NORM2"); 6556 } 6557 } 6558 6559 // NOT 6560 mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType, 6561 llvm::ArrayRef<mlir::Value> args) { 6562 assert(args.size() == 1); 6563 mlir::Type signlessType = mlir::IntegerType::get( 6564 builder.getContext(), resultType.getIntOrFloatBitWidth(), 6565 mlir::IntegerType::SignednessSemantics::Signless); 6566 mlir::Value allOnes = builder.createAllOnesInteger(loc, signlessType); 6567 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0], 6568 allOnes); 6569 } 6570 6571 // NULL 6572 fir::ExtendedValue 6573 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) { 6574 // NULL() without MOLD must be handled in the contexts where it can appear 6575 // (see table 16.5 of Fortran 2018 standard). 6576 assert(args.size() == 1 && isStaticallyPresent(args[0]) && 6577 "MOLD argument required to lower NULL outside of any context"); 6578 mlir::Type ptrTy = fir::getBase(args[0]).getType(); 6579 if (ptrTy && fir::isBoxProcAddressType(ptrTy)) { 6580 auto boxProcType = mlir::cast<fir::BoxProcType>(fir::unwrapRefType(ptrTy)); 6581 mlir::Value boxStorage = builder.createTemporary(loc, boxProcType); 6582 mlir::Value nullBoxProc = 6583 fir::factory::createNullBoxProc(builder, loc, boxProcType); 6584 builder.createStoreWithConvert(loc, nullBoxProc, boxStorage); 6585 return boxStorage; 6586 } 6587 const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>(); 6588 assert(mold && "MOLD must be a pointer or allocatable"); 6589 fir::BaseBoxType boxType = mold->getBoxTy(); 6590 mlir::Value boxStorage = builder.createTemporary(loc, boxType); 6591 mlir::Value box = fir::factory::createUnallocatedBox( 6592 builder, loc, boxType, mold->nonDeferredLenParams()); 6593 builder.create<fir::StoreOp>(loc, box, boxStorage); 6594 return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {}); 6595 } 6596 6597 // PACK 6598 fir::ExtendedValue 6599 IntrinsicLibrary::genPack(mlir::Type resultType, 6600 llvm::ArrayRef<fir::ExtendedValue> args) { 6601 [[maybe_unused]] auto numArgs = args.size(); 6602 assert(numArgs == 2 || numArgs == 3); 6603 6604 // Handle required array argument 6605 mlir::Value array = builder.createBox(loc, args[0]); 6606 6607 // Handle required mask argument 6608 mlir::Value mask = builder.createBox(loc, args[1]); 6609 6610 // Handle optional vector argument 6611 mlir::Value vector = isStaticallyAbsent(args, 2) 6612 ? builder.create<fir::AbsentOp>( 6613 loc, fir::BoxType::get(builder.getI1Type())) 6614 : builder.createBox(loc, args[2]); 6615 6616 // Create mutable fir.box to be passed to the runtime for the result. 6617 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1); 6618 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 6619 builder, loc, resultArrayType, {}, 6620 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{}); 6621 mlir::Value resultIrBox = 6622 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6623 6624 fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector); 6625 6626 return readAndAddCleanUp(resultMutableBox, resultType, "PACK"); 6627 } 6628 6629 // PARITY 6630 fir::ExtendedValue 6631 IntrinsicLibrary::genParity(mlir::Type resultType, 6632 llvm::ArrayRef<fir::ExtendedValue> args) { 6633 6634 assert(args.size() == 2); 6635 // Handle required mask argument 6636 mlir::Value mask = builder.createBox(loc, args[0]); 6637 6638 fir::BoxValue maskArry = builder.createBox(loc, args[0]); 6639 int rank = maskArry.rank(); 6640 assert(rank >= 1); 6641 6642 // Handle optional dim argument 6643 bool absentDim = isStaticallyAbsent(args[1]); 6644 mlir::Value dim = 6645 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1) 6646 : fir::getBase(args[1]); 6647 6648 if (rank == 1 || absentDim) 6649 return builder.createConvert( 6650 loc, resultType, fir::runtime::genParity(builder, loc, mask, dim)); 6651 6652 // else use the result descriptor ParityDim() intrinsic 6653 6654 // Create mutable fir.box to be passed to the runtime for the result. 6655 6656 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 6657 fir::MutableBoxValue resultMutableBox = 6658 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 6659 mlir::Value resultIrBox = 6660 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6661 6662 // Call runtime. The runtime is allocating the result. 6663 fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim); 6664 return readAndAddCleanUp(resultMutableBox, resultType, "PARITY"); 6665 } 6666 6667 // POPCNT 6668 mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType, 6669 llvm::ArrayRef<mlir::Value> args) { 6670 assert(args.size() == 1); 6671 6672 mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args); 6673 6674 return builder.createConvert(loc, resultType, count); 6675 } 6676 6677 // POPPAR 6678 mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType, 6679 llvm::ArrayRef<mlir::Value> args) { 6680 assert(args.size() == 1); 6681 6682 mlir::Value count = genPopcnt(resultType, args); 6683 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1); 6684 6685 return builder.create<mlir::arith::AndIOp>(loc, count, one); 6686 } 6687 6688 // PRESENT 6689 fir::ExtendedValue 6690 IntrinsicLibrary::genPresent(mlir::Type, 6691 llvm::ArrayRef<fir::ExtendedValue> args) { 6692 assert(args.size() == 1); 6693 return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), 6694 fir::getBase(args[0])); 6695 } 6696 6697 // PRODUCT 6698 fir::ExtendedValue 6699 IntrinsicLibrary::genProduct(mlir::Type resultType, 6700 llvm::ArrayRef<fir::ExtendedValue> args) { 6701 return genReduction(fir::runtime::genProduct, fir::runtime::genProductDim, 6702 "PRODUCT", resultType, args); 6703 } 6704 6705 // RANDOM_INIT 6706 void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) { 6707 assert(args.size() == 2); 6708 fir::runtime::genRandomInit(builder, loc, fir::getBase(args[0]), 6709 fir::getBase(args[1])); 6710 } 6711 6712 // RANDOM_NUMBER 6713 void IntrinsicLibrary::genRandomNumber( 6714 llvm::ArrayRef<fir::ExtendedValue> args) { 6715 assert(args.size() == 1); 6716 fir::runtime::genRandomNumber(builder, loc, fir::getBase(args[0])); 6717 } 6718 6719 // RANDOM_SEED 6720 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) { 6721 assert(args.size() == 3); 6722 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 6723 auto getDesc = [&](int i) { 6724 return isStaticallyPresent(args[i]) 6725 ? fir::getBase(args[i]) 6726 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 6727 }; 6728 mlir::Value size = getDesc(0); 6729 mlir::Value put = getDesc(1); 6730 mlir::Value get = getDesc(2); 6731 fir::runtime::genRandomSeed(builder, loc, size, put, get); 6732 } 6733 6734 // REDUCE 6735 fir::ExtendedValue 6736 IntrinsicLibrary::genReduce(mlir::Type resultType, 6737 llvm::ArrayRef<fir::ExtendedValue> args) { 6738 assert(args.size() == 6); 6739 6740 fir::BoxValue arrayTmp = builder.createBox(loc, args[0]); 6741 mlir::Value array = fir::getBase(arrayTmp); 6742 mlir::Value operation = fir::getBase(args[1]); 6743 int rank = arrayTmp.rank(); 6744 assert(rank >= 1); 6745 6746 // Arguements to the reduction operation are passed by reference or value? 6747 bool argByRef = true; 6748 if (!operation.getDefiningOp()) 6749 TODO(loc, "Distinguigh dummy procedure arguments"); 6750 if (auto embox = 6751 mlir::dyn_cast_or_null<fir::EmboxProcOp>(operation.getDefiningOp())) { 6752 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(embox.getFunc().getType()); 6753 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0)); 6754 } else if (auto load = mlir::dyn_cast_or_null<fir::LoadOp>( 6755 operation.getDefiningOp())) { 6756 auto boxProcTy = mlir::dyn_cast_or_null<fir::BoxProcType>(load.getType()); 6757 assert(boxProcTy && "expect BoxProcType"); 6758 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(boxProcTy.getEleTy()); 6759 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0)); 6760 } 6761 6762 mlir::Type ty = array.getType(); 6763 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty); 6764 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType(); 6765 6766 // Handle optional arguments 6767 bool absentDim = isStaticallyAbsent(args[2]); 6768 6769 auto mask = isStaticallyAbsent(args[3]) 6770 ? builder.create<fir::AbsentOp>( 6771 loc, fir::BoxType::get(builder.getI1Type())) 6772 : builder.createBox(loc, args[3]); 6773 6774 mlir::Value identity = 6775 isStaticallyAbsent(args[4]) 6776 ? builder.create<fir::AbsentOp>(loc, fir::ReferenceType::get(eleTy)) 6777 : fir::getBase(args[4]); 6778 6779 mlir::Value ordered = isStaticallyAbsent(args[5]) 6780 ? builder.createBool(loc, false) 6781 : fir::getBase(args[5]); 6782 6783 // We call the type specific versions because the result is scalar 6784 // in the case below. 6785 if (absentDim || rank == 1) { 6786 if (fir::isa_complex(eleTy) || fir::isa_derived(eleTy)) { 6787 mlir::Value result = builder.createTemporary(loc, eleTy); 6788 fir::runtime::genReduce(builder, loc, array, operation, mask, identity, 6789 ordered, result, argByRef); 6790 if (fir::isa_derived(eleTy)) 6791 return result; 6792 return builder.create<fir::LoadOp>(loc, result); 6793 } 6794 if (fir::isa_char(eleTy)) { 6795 auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(resultType); 6796 assert(charTy && "expect CharacterType"); 6797 fir::factory::CharacterExprHelper charHelper(builder, loc); 6798 mlir::Value len; 6799 if (charTy.hasDynamicLen()) 6800 len = charHelper.readLengthFromBox(fir::getBase(arrayTmp), charTy); 6801 else 6802 len = builder.createIntegerConstant(loc, builder.getI32Type(), 6803 charTy.getLen()); 6804 fir::CharBoxValue temp = charHelper.createCharacterTemp(eleTy, len); 6805 fir::runtime::genReduce(builder, loc, array, operation, mask, identity, 6806 ordered, temp.getBuffer(), argByRef); 6807 return temp; 6808 } 6809 return fir::runtime::genReduce(builder, loc, array, operation, mask, 6810 identity, ordered, argByRef); 6811 } 6812 // Handle cases that have an array result. 6813 // Create mutable fir.box to be passed to the runtime for the result. 6814 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1); 6815 fir::MutableBoxValue resultMutableBox = 6816 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 6817 mlir::Value resultIrBox = 6818 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6819 mlir::Value dim = fir::getBase(args[2]); 6820 fir::runtime::genReduceDim(builder, loc, array, operation, dim, mask, 6821 identity, ordered, resultIrBox, argByRef); 6822 return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE"); 6823 } 6824 6825 // RENAME 6826 fir::ExtendedValue 6827 IntrinsicLibrary::genRename(std::optional<mlir::Type> resultType, 6828 mlir::ArrayRef<fir::ExtendedValue> args) { 6829 assert((args.size() == 3 && !resultType.has_value()) || 6830 (args.size() == 2 && resultType.has_value())); 6831 6832 mlir::Value path1 = fir::getBase(args[0]); 6833 mlir::Value path2 = fir::getBase(args[1]); 6834 if (!path1 || !path2) 6835 fir::emitFatalError(loc, "Expected at least two dummy arguments"); 6836 6837 if (resultType.has_value()) { 6838 // code-gen for the function form of RENAME 6839 auto statusAddr = builder.createTemporary(loc, *resultType); 6840 auto statusBox = builder.createBox(loc, statusAddr); 6841 fir::runtime::genRename(builder, loc, path1, path2, statusBox); 6842 return builder.create<fir::LoadOp>(loc, statusAddr); 6843 } else { 6844 // code-gen for the procedure form of RENAME 6845 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 6846 auto status = args[2]; 6847 mlir::Value statusBox = 6848 isStaticallyPresent(status) 6849 ? fir::getBase(status) 6850 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 6851 fir::runtime::genRename(builder, loc, path1, path2, statusBox); 6852 return {}; 6853 } 6854 } 6855 6856 // REPEAT 6857 fir::ExtendedValue 6858 IntrinsicLibrary::genRepeat(mlir::Type resultType, 6859 llvm::ArrayRef<fir::ExtendedValue> args) { 6860 assert(args.size() == 2); 6861 mlir::Value string = builder.createBox(loc, args[0]); 6862 mlir::Value ncopies = fir::getBase(args[1]); 6863 // Create mutable fir.box to be passed to the runtime for the result. 6864 fir::MutableBoxValue resultMutableBox = 6865 fir::factory::createTempMutableBox(builder, loc, resultType); 6866 mlir::Value resultIrBox = 6867 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6868 // Call runtime. The runtime is allocating the result. 6869 fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies); 6870 // Read result from mutable fir.box and add it to the list of temps to be 6871 // finalized by the StatementContext. 6872 return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT"); 6873 } 6874 6875 // RESHAPE 6876 fir::ExtendedValue 6877 IntrinsicLibrary::genReshape(mlir::Type resultType, 6878 llvm::ArrayRef<fir::ExtendedValue> args) { 6879 assert(args.size() == 4); 6880 6881 // Handle source argument 6882 mlir::Value source = builder.createBox(loc, args[0]); 6883 6884 // Handle shape argument 6885 mlir::Value shape = builder.createBox(loc, args[1]); 6886 assert(fir::BoxValue(shape).rank() == 1); 6887 mlir::Type shapeTy = shape.getType(); 6888 mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy); 6889 auto resultRank = mlir::cast<fir::SequenceType>(shapeArrTy).getShape()[0]; 6890 6891 if (resultRank == fir::SequenceType::getUnknownExtent()) 6892 TODO(loc, "intrinsic: reshape requires computing rank of result"); 6893 6894 // Handle optional pad argument 6895 mlir::Value pad = isStaticallyAbsent(args[2]) 6896 ? builder.create<fir::AbsentOp>( 6897 loc, fir::BoxType::get(builder.getI1Type())) 6898 : builder.createBox(loc, args[2]); 6899 6900 // Handle optional order argument 6901 mlir::Value order = isStaticallyAbsent(args[3]) 6902 ? builder.create<fir::AbsentOp>( 6903 loc, fir::BoxType::get(builder.getI1Type())) 6904 : builder.createBox(loc, args[3]); 6905 6906 // Create mutable fir.box to be passed to the runtime for the result. 6907 mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank); 6908 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 6909 builder, loc, type, {}, 6910 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{}); 6911 6912 mlir::Value resultIrBox = 6913 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 6914 6915 fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad, 6916 order); 6917 6918 return readAndAddCleanUp(resultMutableBox, resultType, "RESHAPE"); 6919 } 6920 6921 // RRSPACING 6922 mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType, 6923 llvm::ArrayRef<mlir::Value> args) { 6924 assert(args.size() == 1); 6925 6926 return builder.createConvert( 6927 loc, resultType, 6928 fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0]))); 6929 } 6930 6931 // ERFC_SCALED 6932 mlir::Value IntrinsicLibrary::genErfcScaled(mlir::Type resultType, 6933 llvm::ArrayRef<mlir::Value> args) { 6934 assert(args.size() == 1); 6935 6936 return builder.createConvert( 6937 loc, resultType, 6938 fir::runtime::genErfcScaled(builder, loc, fir::getBase(args[0]))); 6939 } 6940 6941 // SAME_TYPE_AS 6942 fir::ExtendedValue 6943 IntrinsicLibrary::genSameTypeAs(mlir::Type resultType, 6944 llvm::ArrayRef<fir::ExtendedValue> args) { 6945 assert(args.size() == 2); 6946 6947 return builder.createConvert( 6948 loc, resultType, 6949 fir::runtime::genSameTypeAs(builder, loc, fir::getBase(args[0]), 6950 fir::getBase(args[1]))); 6951 } 6952 6953 // SCALE 6954 mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType, 6955 llvm::ArrayRef<mlir::Value> args) { 6956 assert(args.size() == 2); 6957 6958 mlir::Value realX = fir::getBase(args[0]); 6959 mlir::Value intI = fir::getBase(args[1]); 6960 6961 return builder.createConvert( 6962 loc, resultType, fir::runtime::genScale(builder, loc, realX, intI)); 6963 } 6964 6965 // SCAN 6966 fir::ExtendedValue 6967 IntrinsicLibrary::genScan(mlir::Type resultType, 6968 llvm::ArrayRef<fir::ExtendedValue> args) { 6969 6970 assert(args.size() == 4); 6971 6972 if (isStaticallyAbsent(args[3])) { 6973 // Kind not specified, so call scan/verify runtime routine that is 6974 // specialized on the kind of characters in string. 6975 6976 // Handle required string base arg 6977 mlir::Value stringBase = fir::getBase(args[0]); 6978 6979 // Handle required set string base arg 6980 mlir::Value setBase = fir::getBase(args[1]); 6981 6982 // Handle kind argument; it is the kind of character in this case 6983 fir::KindTy kind = 6984 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind( 6985 stringBase.getType()); 6986 6987 // Get string length argument 6988 mlir::Value stringLen = fir::getLen(args[0]); 6989 6990 // Get set string length argument 6991 mlir::Value setLen = fir::getLen(args[1]); 6992 6993 // Handle optional back argument 6994 mlir::Value back = 6995 isStaticallyAbsent(args[2]) 6996 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0) 6997 : fir::getBase(args[2]); 6998 6999 return builder.createConvert(loc, resultType, 7000 fir::runtime::genScan(builder, loc, kind, 7001 stringBase, stringLen, 7002 setBase, setLen, back)); 7003 } 7004 // else use the runtime descriptor version of scan/verify 7005 7006 // Handle optional argument, back 7007 auto makeRefThenEmbox = [&](mlir::Value b) { 7008 fir::LogicalType logTy = fir::LogicalType::get( 7009 builder.getContext(), builder.getKindMap().defaultLogicalKind()); 7010 mlir::Value temp = builder.createTemporary(loc, logTy); 7011 mlir::Value castb = builder.createConvert(loc, logTy, b); 7012 builder.create<fir::StoreOp>(loc, castb, temp); 7013 return builder.createBox(loc, temp); 7014 }; 7015 mlir::Value back = fir::isUnboxedValue(args[2]) 7016 ? makeRefThenEmbox(*args[2].getUnboxed()) 7017 : builder.create<fir::AbsentOp>( 7018 loc, fir::BoxType::get(builder.getI1Type())); 7019 7020 // Handle required string argument 7021 mlir::Value string = builder.createBox(loc, args[0]); 7022 7023 // Handle required set argument 7024 mlir::Value set = builder.createBox(loc, args[1]); 7025 7026 // Handle kind argument 7027 mlir::Value kind = fir::getBase(args[3]); 7028 7029 // Create result descriptor 7030 fir::MutableBoxValue resultMutableBox = 7031 fir::factory::createTempMutableBox(builder, loc, resultType); 7032 mlir::Value resultIrBox = 7033 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7034 7035 fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back, 7036 kind); 7037 7038 // Handle cleanup of allocatable result descriptor and return 7039 return readAndAddCleanUp(resultMutableBox, resultType, "SCAN"); 7040 } 7041 7042 // SECOND 7043 fir::ExtendedValue 7044 IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType, 7045 mlir::ArrayRef<fir::ExtendedValue> args) { 7046 assert((args.size() == 1 && !resultType) || (args.empty() && resultType)); 7047 7048 fir::ExtendedValue result; 7049 7050 if (resultType) 7051 result = builder.createTemporary(loc, *resultType); 7052 else 7053 result = args[0]; 7054 7055 llvm::SmallVector<fir::ExtendedValue, 1> subroutineArgs(1, result); 7056 genCpuTime(subroutineArgs); 7057 7058 if (resultType) 7059 return builder.create<fir::LoadOp>(loc, fir::getBase(result)); 7060 return {}; 7061 } 7062 7063 // SELECTED_CHAR_KIND 7064 fir::ExtendedValue 7065 IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType, 7066 llvm::ArrayRef<fir::ExtendedValue> args) { 7067 assert(args.size() == 1); 7068 7069 return builder.createConvert( 7070 loc, resultType, 7071 fir::runtime::genSelectedCharKind(builder, loc, fir::getBase(args[0]), 7072 fir::getLen(args[0]))); 7073 } 7074 7075 // SELECTED_INT_KIND 7076 mlir::Value 7077 IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType, 7078 llvm::ArrayRef<mlir::Value> args) { 7079 assert(args.size() == 1); 7080 7081 return builder.createConvert( 7082 loc, resultType, 7083 fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0]))); 7084 } 7085 7086 // SELECTED_LOGICAL_KIND 7087 mlir::Value 7088 IntrinsicLibrary::genSelectedLogicalKind(mlir::Type resultType, 7089 llvm::ArrayRef<mlir::Value> args) { 7090 assert(args.size() == 1); 7091 7092 return builder.createConvert(loc, resultType, 7093 fir::runtime::genSelectedLogicalKind( 7094 builder, loc, fir::getBase(args[0]))); 7095 } 7096 7097 // SELECTED_REAL_KIND 7098 mlir::Value 7099 IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType, 7100 llvm::ArrayRef<mlir::Value> args) { 7101 assert(args.size() == 3); 7102 7103 // Handle optional precision(P) argument 7104 mlir::Value precision = 7105 isStaticallyAbsent(args[0]) 7106 ? builder.create<fir::AbsentOp>( 7107 loc, fir::ReferenceType::get(builder.getI1Type())) 7108 : fir::getBase(args[0]); 7109 7110 // Handle optional range(R) argument 7111 mlir::Value range = 7112 isStaticallyAbsent(args[1]) 7113 ? builder.create<fir::AbsentOp>( 7114 loc, fir::ReferenceType::get(builder.getI1Type())) 7115 : fir::getBase(args[1]); 7116 7117 // Handle optional radix(RADIX) argument 7118 mlir::Value radix = 7119 isStaticallyAbsent(args[2]) 7120 ? builder.create<fir::AbsentOp>( 7121 loc, fir::ReferenceType::get(builder.getI1Type())) 7122 : fir::getBase(args[2]); 7123 7124 return builder.createConvert( 7125 loc, resultType, 7126 fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix)); 7127 } 7128 7129 // SET_EXPONENT 7130 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType, 7131 llvm::ArrayRef<mlir::Value> args) { 7132 assert(args.size() == 2); 7133 7134 return builder.createConvert( 7135 loc, resultType, 7136 fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]), 7137 fir::getBase(args[1]))); 7138 } 7139 7140 /// Create a fir.box to be passed to the LBOUND/UBOUND runtime. 7141 /// This ensure that local lower bounds of assumed shape are propagated and that 7142 /// a fir.box with equivalent LBOUNDs. 7143 static mlir::Value 7144 createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder, 7145 const fir::ExtendedValue &array) { 7146 // Assumed-rank descriptor must always carry accurate lower bound information 7147 // in lowering since they cannot be tracked on the side in a vector at compile 7148 // time. 7149 if (array.hasAssumedRank()) 7150 return builder.createBox(loc, array); 7151 7152 return array.match( 7153 [&](const fir::BoxValue &boxValue) -> mlir::Value { 7154 // This entity is mapped to a fir.box that may not contain the local 7155 // lower bound information if it is a dummy. Rebox it with the local 7156 // shape information. 7157 mlir::Value localShape = builder.createShape(loc, array); 7158 mlir::Value oldBox = boxValue.getAddr(); 7159 return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox, 7160 localShape, 7161 /*slice=*/mlir::Value{}); 7162 }, 7163 [&](const auto &) -> mlir::Value { 7164 // This is a pointer/allocatable, or an entity not yet tracked with a 7165 // fir.box. For pointer/allocatable, createBox will forward the 7166 // descriptor that contains the correct lower bound information. For 7167 // other entities, a new fir.box will be made with the local lower 7168 // bounds. 7169 return builder.createBox(loc, array); 7170 }); 7171 } 7172 7173 /// Generate runtime call to inquire about all the bounds/extents of an 7174 /// array (or an assumed-rank). 7175 template <typename Func> 7176 static fir::ExtendedValue 7177 genBoundInquiry(fir::FirOpBuilder &builder, mlir::Location loc, 7178 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args, 7179 int kindPos, Func genRtCall, bool needAccurateLowerBound) { 7180 const fir::ExtendedValue &array = args[0]; 7181 const bool hasAssumedRank = array.hasAssumedRank(); 7182 mlir::Type resultElementType = fir::unwrapSequenceType(resultType); 7183 // For assumed-rank arrays, allocate an array with the maximum rank, that is 7184 // big enough to hold the result but still "small" (15 elements). Static size 7185 // alloca make stack analysis/manipulation easier. 7186 int rank = hasAssumedRank ? Fortran::common::maxRank : array.rank(); 7187 mlir::Type allocSeqType = fir::SequenceType::get(rank, resultElementType); 7188 mlir::Value resultStorage = builder.createTemporary(loc, allocSeqType); 7189 mlir::Value arrayBox = 7190 needAccurateLowerBound 7191 ? createBoxForRuntimeBoundInquiry(loc, builder, array) 7192 : builder.createBox(loc, array); 7193 mlir::Value kind = isStaticallyAbsent(args, kindPos) 7194 ? builder.createIntegerConstant( 7195 loc, builder.getI32Type(), 7196 builder.getKindMap().defaultIntegerKind()) 7197 : fir::getBase(args[kindPos]); 7198 genRtCall(builder, loc, resultStorage, arrayBox, kind); 7199 if (hasAssumedRank) { 7200 // Cast to fir.ref<array<?xik>> since the result extent is not a compile 7201 // time constant. 7202 mlir::Type baseType = 7203 fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType)); 7204 mlir::Value resultBase = 7205 builder.createConvert(loc, baseType, resultStorage); 7206 mlir::Value rankValue = 7207 builder.create<fir::BoxRankOp>(loc, builder.getIndexType(), arrayBox); 7208 return fir::ArrayBoxValue{resultBase, {rankValue}}; 7209 } 7210 // Result extent is a compile time constant in the other cases. 7211 mlir::Value rankValue = 7212 builder.createIntegerConstant(loc, builder.getIndexType(), rank); 7213 return fir::ArrayBoxValue{resultStorage, {rankValue}}; 7214 } 7215 7216 // SHAPE 7217 fir::ExtendedValue 7218 IntrinsicLibrary::genShape(mlir::Type resultType, 7219 llvm::ArrayRef<fir::ExtendedValue> args) { 7220 assert(args.size() >= 1); 7221 const fir::ExtendedValue &array = args[0]; 7222 if (array.hasAssumedRank()) 7223 return genBoundInquiry(builder, loc, resultType, args, 7224 /*kindPos=*/1, fir::runtime::genShape, 7225 /*needAccurateLowerBound=*/false); 7226 int rank = array.rank(); 7227 mlir::Type indexType = builder.getIndexType(); 7228 mlir::Type extentType = fir::unwrapSequenceType(resultType); 7229 mlir::Type seqType = fir::SequenceType::get( 7230 {static_cast<fir::SequenceType::Extent>(rank)}, extentType); 7231 mlir::Value shapeArray = builder.createTemporary(loc, seqType); 7232 mlir::Type shapeAddrType = builder.getRefType(extentType); 7233 for (int dim = 0; dim < rank; ++dim) { 7234 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim); 7235 extent = builder.createConvert(loc, extentType, extent); 7236 auto index = builder.createIntegerConstant(loc, indexType, dim); 7237 auto shapeAddr = builder.create<fir::CoordinateOp>(loc, shapeAddrType, 7238 shapeArray, index); 7239 builder.create<fir::StoreOp>(loc, extent, shapeAddr); 7240 } 7241 mlir::Value shapeArrayExtent = 7242 builder.createIntegerConstant(loc, indexType, rank); 7243 llvm::SmallVector<mlir::Value> extents{shapeArrayExtent}; 7244 return fir::ArrayBoxValue{shapeArray, extents}; 7245 } 7246 7247 // SHIFTL, SHIFTR 7248 template <typename Shift> 7249 mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType, 7250 llvm::ArrayRef<mlir::Value> args) { 7251 assert(args.size() == 2); 7252 7253 // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by 7254 // the standard. However, several other compilers behave this way, so try and 7255 // maintain compatibility with them to an extent. 7256 7257 unsigned bits = resultType.getIntOrFloatBitWidth(); 7258 mlir::Type signlessType = 7259 mlir::IntegerType::get(builder.getContext(), bits, 7260 mlir::IntegerType::SignednessSemantics::Signless); 7261 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits); 7262 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 7263 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]); 7264 7265 mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>( 7266 loc, mlir::arith::CmpIPredicate::slt, shift, zero); 7267 mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>( 7268 loc, mlir::arith::CmpIPredicate::sge, shift, bitSize); 7269 mlir::Value outOfBounds = 7270 builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge); 7271 mlir::Value word = args[0]; 7272 if (word.getType().isUnsignedInteger()) 7273 word = builder.createConvert(loc, signlessType, word); 7274 mlir::Value shifted = builder.create<Shift>(loc, word, shift); 7275 mlir::Value result = 7276 builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted); 7277 if (resultType.isUnsignedInteger()) 7278 return builder.createConvert(loc, resultType, result); 7279 return result; 7280 } 7281 7282 // SHIFTA 7283 mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType, 7284 llvm::ArrayRef<mlir::Value> args) { 7285 unsigned bits = resultType.getIntOrFloatBitWidth(); 7286 mlir::Type signlessType = 7287 mlir::IntegerType::get(builder.getContext(), bits, 7288 mlir::IntegerType::SignednessSemantics::Signless); 7289 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits); 7290 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]); 7291 mlir::Value shiftGeBitSize = builder.create<mlir::arith::CmpIOp>( 7292 loc, mlir::arith::CmpIPredicate::uge, shift, bitSize); 7293 7294 // Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when 7295 // the shift amount is equal to the element size. 7296 // So if SHIFT is equal to the bit width then it is handled as a special case. 7297 // When negative or larger than the bit width, handle it like other 7298 // Fortran compiler do (treat it as bit width, minus 1). 7299 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0); 7300 mlir::Value minusOne = builder.createMinusOneInteger(loc, signlessType); 7301 mlir::Value word = args[0]; 7302 if (word.getType().isUnsignedInteger()) 7303 word = builder.createConvert(loc, signlessType, word); 7304 mlir::Value valueIsNeg = builder.create<mlir::arith::CmpIOp>( 7305 loc, mlir::arith::CmpIPredicate::slt, word, zero); 7306 mlir::Value specialRes = 7307 builder.create<mlir::arith::SelectOp>(loc, valueIsNeg, minusOne, zero); 7308 mlir::Value shifted = builder.create<mlir::arith::ShRSIOp>(loc, word, shift); 7309 mlir::Value result = builder.create<mlir::arith::SelectOp>( 7310 loc, shiftGeBitSize, specialRes, shifted); 7311 if (resultType.isUnsignedInteger()) 7312 return builder.createConvert(loc, resultType, result); 7313 return result; 7314 } 7315 7316 // SIGNAL 7317 void IntrinsicLibrary::genSignalSubroutine( 7318 llvm::ArrayRef<fir::ExtendedValue> args) { 7319 assert(args.size() == 2 || args.size() == 3); 7320 mlir::Value number = fir::getBase(args[0]); 7321 mlir::Value handler = fir::getBase(args[1]); 7322 mlir::Value status; 7323 if (args.size() == 3) 7324 status = fir::getBase(args[2]); 7325 fir::runtime::genSignal(builder, loc, number, handler, status); 7326 } 7327 7328 // SIGN 7329 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, 7330 llvm::ArrayRef<mlir::Value> args) { 7331 assert(args.size() == 2); 7332 if (mlir::isa<mlir::IntegerType>(resultType)) { 7333 mlir::Value abs = genAbs(resultType, {args[0]}); 7334 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0); 7335 auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs); 7336 auto cmp = builder.create<mlir::arith::CmpIOp>( 7337 loc, mlir::arith::CmpIPredicate::slt, args[1], zero); 7338 return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs); 7339 } 7340 return genRuntimeCall("sign", resultType, args); 7341 } 7342 7343 // SIND 7344 mlir::Value IntrinsicLibrary::genSind(mlir::Type resultType, 7345 llvm::ArrayRef<mlir::Value> args) { 7346 assert(args.size() == 1); 7347 mlir::MLIRContext *context = builder.getContext(); 7348 mlir::FunctionType ftype = 7349 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 7350 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 7351 mlir::Value dfactor = builder.createRealConstant( 7352 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0)); 7353 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor); 7354 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor); 7355 return getRuntimeCallGenerator("sin", ftype)(builder, loc, {arg}); 7356 } 7357 7358 // SIZE 7359 fir::ExtendedValue 7360 IntrinsicLibrary::genSize(mlir::Type resultType, 7361 llvm::ArrayRef<fir::ExtendedValue> args) { 7362 // Note that the value of the KIND argument is already reflected in the 7363 // resultType 7364 assert(args.size() == 3); 7365 7366 // Get the ARRAY argument 7367 mlir::Value array = builder.createBox(loc, args[0]); 7368 7369 // The front-end rewrites SIZE without the DIM argument to 7370 // an array of SIZE with DIM in most cases, but it may not be 7371 // possible in some cases like when in SIZE(function_call()). 7372 if (isStaticallyAbsent(args, 1)) 7373 return builder.createConvert(loc, resultType, 7374 fir::runtime::genSize(builder, loc, array)); 7375 7376 // Get the DIM argument. 7377 mlir::Value dim = fir::getBase(args[1]); 7378 if (!args[0].hasAssumedRank()) 7379 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) { 7380 // If both DIM and the rank are compile time constants, skip the runtime 7381 // call. 7382 return builder.createConvert( 7383 loc, resultType, 7384 fir::factory::readExtent(builder, loc, fir::BoxValue{array}, 7385 cstDim.value() - 1)); 7386 } 7387 if (!fir::isa_ref_type(dim.getType())) 7388 return builder.createConvert( 7389 loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim)); 7390 7391 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim); 7392 return builder 7393 .genIfOp(loc, {resultType}, isDynamicallyAbsent, 7394 /*withElseRegion=*/true) 7395 .genThen([&]() { 7396 mlir::Value size = builder.createConvert( 7397 loc, resultType, fir::runtime::genSize(builder, loc, array)); 7398 builder.create<fir::ResultOp>(loc, size); 7399 }) 7400 .genElse([&]() { 7401 mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim); 7402 mlir::Value size = builder.createConvert( 7403 loc, resultType, 7404 fir::runtime::genSizeDim(builder, loc, array, dimValue)); 7405 builder.create<fir::ResultOp>(loc, size); 7406 }) 7407 .getResults()[0]; 7408 } 7409 7410 // SIZEOF 7411 fir::ExtendedValue 7412 IntrinsicLibrary::genSizeOf(mlir::Type resultType, 7413 llvm::ArrayRef<fir::ExtendedValue> args) { 7414 assert(args.size() == 1); 7415 mlir::Value box = fir::getBase(args[0]); 7416 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, resultType, box); 7417 if (!fir::isArray(args[0])) 7418 return eleSize; 7419 mlir::Value arraySize = builder.createConvert( 7420 loc, resultType, fir::runtime::genSize(builder, loc, box)); 7421 return builder.create<mlir::arith::MulIOp>(loc, eleSize, arraySize); 7422 } 7423 7424 // TAND 7425 mlir::Value IntrinsicLibrary::genTand(mlir::Type resultType, 7426 llvm::ArrayRef<mlir::Value> args) { 7427 assert(args.size() == 1); 7428 mlir::MLIRContext *context = builder.getContext(); 7429 mlir::FunctionType ftype = 7430 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 7431 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi); 7432 mlir::Value dfactor = builder.createRealConstant( 7433 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0)); 7434 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor); 7435 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor); 7436 return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg}); 7437 } 7438 7439 // TRAILZ 7440 mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType, 7441 llvm::ArrayRef<mlir::Value> args) { 7442 assert(args.size() == 1); 7443 7444 mlir::Value result = 7445 builder.create<mlir::math::CountTrailingZerosOp>(loc, args); 7446 7447 return builder.createConvert(loc, resultType, result); 7448 } 7449 7450 static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) { 7451 return exv.match( 7452 [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); }, 7453 [](const fir::CharArrayBoxValue &arr) { 7454 return arr.getLBounds().empty(); 7455 }, 7456 [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); }, 7457 [](const auto &) { return false; }); 7458 } 7459 7460 /// Compute the lower bound in dimension \p dim (zero based) of \p array 7461 /// taking care of returning one when the related extent is zero. 7462 static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc, 7463 const fir::ExtendedValue &array, unsigned dim, 7464 mlir::Value zero, mlir::Value one) { 7465 assert(dim < array.rank() && "invalid dimension"); 7466 if (hasDefaultLowerBound(array)) 7467 return one; 7468 mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one); 7469 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim); 7470 zero = builder.createConvert(loc, extent.getType(), zero); 7471 // Note: for assumed size, the extent is -1, and the lower bound should 7472 // be returned. It is important to test extent == 0 and not extent > 0. 7473 auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>( 7474 loc, mlir::arith::CmpIPredicate::eq, extent, zero); 7475 one = builder.createConvert(loc, lb.getType(), one); 7476 return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb); 7477 } 7478 7479 // LBOUND 7480 fir::ExtendedValue 7481 IntrinsicLibrary::genLbound(mlir::Type resultType, 7482 llvm::ArrayRef<fir::ExtendedValue> args) { 7483 assert(args.size() == 2 || args.size() == 3); 7484 const fir::ExtendedValue &array = args[0]; 7485 // Semantics builds signatures for LBOUND calls as either 7486 // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]). 7487 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1); 7488 if (array.hasAssumedRank() && dimIsAbsent) { 7489 int kindPos = args.size() == 2 ? 1 : 2; 7490 return genBoundInquiry(builder, loc, resultType, args, kindPos, 7491 fir::runtime::genLbound, 7492 /*needAccurateLowerBound=*/true); 7493 } 7494 7495 mlir::Type indexType = builder.getIndexType(); 7496 7497 if (dimIsAbsent) { 7498 // DIM is absent and the rank of array is a compile time constant. 7499 mlir::Type lbType = fir::unwrapSequenceType(resultType); 7500 unsigned rank = array.rank(); 7501 mlir::Type lbArrayType = fir::SequenceType::get( 7502 {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType); 7503 mlir::Value lbArray = builder.createTemporary(loc, lbArrayType); 7504 mlir::Type lbAddrType = builder.getRefType(lbType); 7505 mlir::Value one = builder.createIntegerConstant(loc, lbType, 1); 7506 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0); 7507 for (unsigned dim = 0; dim < rank; ++dim) { 7508 mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one); 7509 lb = builder.createConvert(loc, lbType, lb); 7510 auto index = builder.createIntegerConstant(loc, indexType, dim); 7511 auto lbAddr = 7512 builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index); 7513 builder.create<fir::StoreOp>(loc, lb, lbAddr); 7514 } 7515 mlir::Value lbArrayExtent = 7516 builder.createIntegerConstant(loc, indexType, rank); 7517 llvm::SmallVector<mlir::Value> extents{lbArrayExtent}; 7518 return fir::ArrayBoxValue{lbArray, extents}; 7519 } 7520 // DIM is present. 7521 mlir::Value dim = fir::getBase(args[1]); 7522 7523 // If it is a compile time constant and the rank is known, skip the runtime 7524 // call. 7525 if (!array.hasAssumedRank()) 7526 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) { 7527 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1); 7528 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0); 7529 mlir::Value lb = 7530 computeLBOUND(builder, loc, array, *cstDim - 1, zero, one); 7531 return builder.createConvert(loc, resultType, lb); 7532 } 7533 7534 fir::ExtendedValue box = createBoxForRuntimeBoundInquiry(loc, builder, array); 7535 return builder.createConvert( 7536 loc, resultType, 7537 fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim)); 7538 } 7539 7540 // UBOUND 7541 fir::ExtendedValue 7542 IntrinsicLibrary::genUbound(mlir::Type resultType, 7543 llvm::ArrayRef<fir::ExtendedValue> args) { 7544 assert(args.size() == 3 || args.size() == 2); 7545 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1); 7546 if (!dimIsAbsent) { 7547 // Handle calls to UBOUND with the DIM argument, which return a scalar 7548 mlir::Value extent = fir::getBase(genSize(resultType, args)); 7549 mlir::Value lbound = fir::getBase(genLbound(resultType, args)); 7550 7551 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1); 7552 mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one); 7553 return builder.create<mlir::arith::AddIOp>(loc, ubound, extent); 7554 } 7555 // Handle calls to UBOUND without the DIM argument, which return an array 7556 int kindPos = args.size() == 2 ? 1 : 2; 7557 return genBoundInquiry(builder, loc, resultType, args, kindPos, 7558 fir::runtime::genUbound, 7559 /*needAccurateLowerBound=*/true); 7560 } 7561 7562 // SPACING 7563 mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType, 7564 llvm::ArrayRef<mlir::Value> args) { 7565 assert(args.size() == 1); 7566 7567 return builder.createConvert( 7568 loc, resultType, 7569 fir::runtime::genSpacing(builder, loc, fir::getBase(args[0]))); 7570 } 7571 7572 // SPREAD 7573 fir::ExtendedValue 7574 IntrinsicLibrary::genSpread(mlir::Type resultType, 7575 llvm::ArrayRef<fir::ExtendedValue> args) { 7576 7577 assert(args.size() == 3); 7578 7579 // Handle source argument 7580 mlir::Value source = builder.createBox(loc, args[0]); 7581 fir::BoxValue sourceTmp = source; 7582 unsigned sourceRank = sourceTmp.rank(); 7583 7584 // Handle Dim argument 7585 mlir::Value dim = fir::getBase(args[1]); 7586 7587 // Handle ncopies argument 7588 mlir::Value ncopies = fir::getBase(args[2]); 7589 7590 // Generate result descriptor 7591 mlir::Type resultArrayType = 7592 builder.getVarLenSeqTy(resultType, sourceRank + 1); 7593 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 7594 builder, loc, resultArrayType, {}, 7595 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{}); 7596 mlir::Value resultIrBox = 7597 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7598 7599 fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies); 7600 7601 return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD"); 7602 } 7603 7604 // STORAGE_SIZE 7605 fir::ExtendedValue 7606 IntrinsicLibrary::genStorageSize(mlir::Type resultType, 7607 llvm::ArrayRef<fir::ExtendedValue> args) { 7608 assert(args.size() == 2 || args.size() == 1); 7609 mlir::Value box = fir::getBase(args[0]); 7610 mlir::Type boxTy = box.getType(); 7611 mlir::Type kindTy = builder.getDefaultIntegerType(); 7612 bool needRuntimeCheck = false; 7613 std::string errorMsg; 7614 7615 if (fir::isUnlimitedPolymorphicType(boxTy) && 7616 (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) { 7617 needRuntimeCheck = true; 7618 errorMsg = 7619 fir::isPointerType(boxTy) 7620 ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE" 7621 : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE"; 7622 } 7623 const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>(); 7624 if (needRuntimeCheck && mutBox) { 7625 mlir::Value isNotAllocOrAssoc = 7626 fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox); 7627 builder.genIfThen(loc, isNotAllocOrAssoc) 7628 .genThen([&]() { 7629 fir::runtime::genReportFatalUserError(builder, loc, errorMsg); 7630 }) 7631 .end(); 7632 } 7633 7634 // Handle optional kind argument 7635 bool absentKind = isStaticallyAbsent(args, 1); 7636 if (!absentKind) { 7637 mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp(); 7638 assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) && 7639 "kind not a constant"); 7640 auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind); 7641 kindTy = builder.getIntegerType( 7642 builder.getKindMap().getIntegerBitsize(fir::toInt(constOp))); 7643 } 7644 7645 box = builder.createBox(loc, args[0], 7646 /*isPolymorphic=*/args[0].isPolymorphic()); 7647 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box); 7648 mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8); 7649 return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8); 7650 } 7651 7652 // SUM 7653 fir::ExtendedValue 7654 IntrinsicLibrary::genSum(mlir::Type resultType, 7655 llvm::ArrayRef<fir::ExtendedValue> args) { 7656 return genReduction(fir::runtime::genSum, fir::runtime::genSumDim, "SUM", 7657 resultType, args); 7658 } 7659 7660 // SYNCTHREADS 7661 void IntrinsicLibrary::genSyncThreads(llvm::ArrayRef<fir::ExtendedValue> args) { 7662 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0"; 7663 mlir::FunctionType funcType = 7664 mlir::FunctionType::get(builder.getContext(), {}, {}); 7665 auto funcOp = builder.createFunction(loc, funcName, funcType); 7666 llvm::SmallVector<mlir::Value> noArgs; 7667 builder.create<fir::CallOp>(loc, funcOp, noArgs); 7668 } 7669 7670 // SYNCTHREADS_AND 7671 mlir::Value 7672 IntrinsicLibrary::genSyncThreadsAnd(mlir::Type resultType, 7673 llvm::ArrayRef<mlir::Value> args) { 7674 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.and"; 7675 mlir::MLIRContext *context = builder.getContext(); 7676 mlir::FunctionType ftype = 7677 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 7678 auto funcOp = builder.createFunction(loc, funcName, ftype); 7679 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0); 7680 } 7681 7682 // SYNCTHREADS_COUNT 7683 mlir::Value 7684 IntrinsicLibrary::genSyncThreadsCount(mlir::Type resultType, 7685 llvm::ArrayRef<mlir::Value> args) { 7686 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.popc"; 7687 mlir::MLIRContext *context = builder.getContext(); 7688 mlir::FunctionType ftype = 7689 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 7690 auto funcOp = builder.createFunction(loc, funcName, ftype); 7691 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0); 7692 } 7693 7694 // SYNCTHREADS_OR 7695 mlir::Value 7696 IntrinsicLibrary::genSyncThreadsOr(mlir::Type resultType, 7697 llvm::ArrayRef<mlir::Value> args) { 7698 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.or"; 7699 mlir::MLIRContext *context = builder.getContext(); 7700 mlir::FunctionType ftype = 7701 mlir::FunctionType::get(context, {resultType}, {args[0].getType()}); 7702 auto funcOp = builder.createFunction(loc, funcName, ftype); 7703 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0); 7704 } 7705 7706 // SYSTEM 7707 fir::ExtendedValue 7708 IntrinsicLibrary::genSystem(std::optional<mlir::Type> resultType, 7709 llvm::ArrayRef<fir::ExtendedValue> args) { 7710 assert((!resultType && (args.size() == 2)) || 7711 (resultType && (args.size() == 1))); 7712 mlir::Value command = fir::getBase(args[0]); 7713 assert(command && "expected COMMAND parameter"); 7714 7715 fir::ExtendedValue exitstat; 7716 if (resultType) { 7717 mlir::Value tmp = builder.createTemporary(loc, *resultType); 7718 exitstat = builder.createBox(loc, tmp); 7719 } else { 7720 exitstat = args[1]; 7721 } 7722 7723 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); 7724 7725 mlir::Value waitBool = builder.createBool(loc, true); 7726 mlir::Value exitstatBox = 7727 isStaticallyPresent(exitstat) 7728 ? fir::getBase(exitstat) 7729 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 7730 7731 // Create a dummmy cmdstat to prevent EXECUTE_COMMAND_LINE terminate itself 7732 // when cmdstat is assigned with a non-zero value but not present 7733 mlir::Value tempValue = 7734 builder.createIntegerConstant(loc, builder.getI16Type(), 0); 7735 mlir::Value temp = builder.createTemporary(loc, builder.getI16Type()); 7736 builder.create<fir::StoreOp>(loc, tempValue, temp); 7737 mlir::Value cmdstatBox = builder.createBox(loc, temp); 7738 7739 mlir::Value cmdmsgBox = 7740 builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult(); 7741 7742 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool, 7743 exitstatBox, cmdstatBox, cmdmsgBox); 7744 7745 if (resultType) { 7746 mlir::Value exitstatAddr = builder.create<fir::BoxAddrOp>(loc, exitstatBox); 7747 return builder.create<fir::LoadOp>(loc, fir::getBase(exitstatAddr)); 7748 } 7749 return {}; 7750 } 7751 7752 // SYSTEM_CLOCK 7753 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) { 7754 assert(args.size() == 3); 7755 fir::runtime::genSystemClock(builder, loc, fir::getBase(args[0]), 7756 fir::getBase(args[1]), fir::getBase(args[2])); 7757 } 7758 7759 // SLEEP 7760 void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) { 7761 assert(args.size() == 1 && "SLEEP has one compulsory argument"); 7762 fir::runtime::genSleep(builder, loc, fir::getBase(args[0])); 7763 } 7764 7765 // TRANSFER 7766 fir::ExtendedValue 7767 IntrinsicLibrary::genTransfer(mlir::Type resultType, 7768 llvm::ArrayRef<fir::ExtendedValue> args) { 7769 7770 assert(args.size() >= 2); // args.size() == 2 when size argument is omitted. 7771 7772 // Handle source argument 7773 mlir::Value source = builder.createBox(loc, args[0]); 7774 7775 // Handle mold argument 7776 mlir::Value mold = builder.createBox(loc, args[1]); 7777 fir::BoxValue moldTmp = mold; 7778 unsigned moldRank = moldTmp.rank(); 7779 7780 bool absentSize = (args.size() == 2); 7781 7782 // Create mutable fir.box to be passed to the runtime for the result. 7783 mlir::Type type = (moldRank == 0 && absentSize) 7784 ? resultType 7785 : builder.getVarLenSeqTy(resultType, 1); 7786 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 7787 builder, loc, type, {}, 7788 fir::isPolymorphicType(mold.getType()) ? mold : mlir::Value{}); 7789 7790 if (moldRank == 0 && absentSize) { 7791 // This result is a scalar in this case. 7792 mlir::Value resultIrBox = 7793 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7794 7795 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold); 7796 } else { 7797 // The result is a rank one array in this case. 7798 mlir::Value resultIrBox = 7799 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7800 7801 if (absentSize) { 7802 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold); 7803 } else { 7804 mlir::Value sizeArg = fir::getBase(args[2]); 7805 fir::runtime::genTransferSize(builder, loc, resultIrBox, source, mold, 7806 sizeArg); 7807 } 7808 } 7809 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSFER"); 7810 } 7811 7812 // TRANSPOSE 7813 fir::ExtendedValue 7814 IntrinsicLibrary::genTranspose(mlir::Type resultType, 7815 llvm::ArrayRef<fir::ExtendedValue> args) { 7816 7817 assert(args.size() == 1); 7818 7819 // Handle source argument 7820 mlir::Value source = builder.createBox(loc, args[0]); 7821 7822 // Create mutable fir.box to be passed to the runtime for the result. 7823 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2); 7824 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 7825 builder, loc, resultArrayType, {}, 7826 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{}); 7827 mlir::Value resultIrBox = 7828 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7829 // Call runtime. The runtime is allocating the result. 7830 fir::runtime::genTranspose(builder, loc, resultIrBox, source); 7831 // Read result from mutable fir.box and add it to the list of temps to be 7832 // finalized by the StatementContext. 7833 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSPOSE"); 7834 } 7835 7836 // THREADFENCE 7837 void IntrinsicLibrary::genThreadFence(llvm::ArrayRef<fir::ExtendedValue> args) { 7838 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.gl"; 7839 mlir::FunctionType funcType = 7840 mlir::FunctionType::get(builder.getContext(), {}, {}); 7841 auto funcOp = builder.createFunction(loc, funcName, funcType); 7842 llvm::SmallVector<mlir::Value> noArgs; 7843 builder.create<fir::CallOp>(loc, funcOp, noArgs); 7844 } 7845 7846 // THREADFENCE_BLOCK 7847 void IntrinsicLibrary::genThreadFenceBlock( 7848 llvm::ArrayRef<fir::ExtendedValue> args) { 7849 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.cta"; 7850 mlir::FunctionType funcType = 7851 mlir::FunctionType::get(builder.getContext(), {}, {}); 7852 auto funcOp = builder.createFunction(loc, funcName, funcType); 7853 llvm::SmallVector<mlir::Value> noArgs; 7854 builder.create<fir::CallOp>(loc, funcOp, noArgs); 7855 } 7856 7857 // THREADFENCE_SYSTEM 7858 void IntrinsicLibrary::genThreadFenceSystem( 7859 llvm::ArrayRef<fir::ExtendedValue> args) { 7860 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.sys"; 7861 mlir::FunctionType funcType = 7862 mlir::FunctionType::get(builder.getContext(), {}, {}); 7863 auto funcOp = builder.createFunction(loc, funcName, funcType); 7864 llvm::SmallVector<mlir::Value> noArgs; 7865 builder.create<fir::CallOp>(loc, funcOp, noArgs); 7866 } 7867 7868 // TRIM 7869 fir::ExtendedValue 7870 IntrinsicLibrary::genTrim(mlir::Type resultType, 7871 llvm::ArrayRef<fir::ExtendedValue> args) { 7872 assert(args.size() == 1); 7873 mlir::Value string = builder.createBox(loc, args[0]); 7874 // Create mutable fir.box to be passed to the runtime for the result. 7875 fir::MutableBoxValue resultMutableBox = 7876 fir::factory::createTempMutableBox(builder, loc, resultType); 7877 mlir::Value resultIrBox = 7878 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7879 // Call runtime. The runtime is allocating the result. 7880 fir::runtime::genTrim(builder, loc, resultIrBox, string); 7881 // Read result from mutable fir.box and add it to the list of temps to be 7882 // finalized by the StatementContext. 7883 return readAndAddCleanUp(resultMutableBox, resultType, "TRIM"); 7884 } 7885 7886 // Compare two FIR values and return boolean result as i1. 7887 template <Extremum extremum, ExtremumBehavior behavior> 7888 static mlir::Value createExtremumCompare(mlir::Location loc, 7889 fir::FirOpBuilder &builder, 7890 mlir::Value left, mlir::Value right) { 7891 mlir::Type type = left.getType(); 7892 mlir::arith::CmpIPredicate integerPredicate = 7893 type.isUnsignedInteger() ? extremum == Extremum::Max 7894 ? mlir::arith::CmpIPredicate::ugt 7895 : mlir::arith::CmpIPredicate::ult 7896 : extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt 7897 : mlir::arith::CmpIPredicate::slt; 7898 static constexpr mlir::arith::CmpFPredicate orderedCmp = 7899 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT 7900 : mlir::arith::CmpFPredicate::OLT; 7901 mlir::Value result; 7902 if (fir::isa_real(type)) { 7903 // Note: the signaling/quit aspect of the result required by IEEE 7904 // cannot currently be obtained with LLVM without ad-hoc runtime. 7905 if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) { 7906 // Return the number if one of the inputs is NaN and the other is 7907 // a number. 7908 auto leftIsResult = 7909 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right); 7910 auto rightIsNan = builder.create<mlir::arith::CmpFOp>( 7911 loc, mlir::arith::CmpFPredicate::UNE, right, right); 7912 result = 7913 builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan); 7914 } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { 7915 // Always return NaNs if one the input is NaNs 7916 auto leftIsResult = 7917 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right); 7918 auto leftIsNan = builder.create<mlir::arith::CmpFOp>( 7919 loc, mlir::arith::CmpFPredicate::UNE, left, left); 7920 result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan); 7921 } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { 7922 // If the left is a NaN, return the right whatever it is. 7923 result = 7924 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right); 7925 } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { 7926 // If one of the operand is a NaN, return left whatever it is. 7927 static constexpr auto unorderedCmp = 7928 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT 7929 : mlir::arith::CmpFPredicate::ULT; 7930 result = 7931 builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right); 7932 } else { 7933 // TODO: ieeeMinNum/ieeeMaxNum 7934 static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, 7935 "ieeeMinNum/ieeeMaxNum behavior not implemented"); 7936 } 7937 } else if (fir::isa_integer(type)) { 7938 if (type.isUnsignedInteger()) { 7939 mlir::Type signlessType = mlir::IntegerType::get( 7940 builder.getContext(), type.getIntOrFloatBitWidth(), 7941 mlir::IntegerType::SignednessSemantics::Signless); 7942 left = builder.createConvert(loc, signlessType, left); 7943 right = builder.createConvert(loc, signlessType, right); 7944 } 7945 result = 7946 builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right); 7947 } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) { 7948 // TODO: ! character min and max is tricky because the result 7949 // length is the length of the longest argument! 7950 // So we may need a temp. 7951 TODO(loc, "intrinsic: min and max for CHARACTER"); 7952 } 7953 assert(result && "result must be defined"); 7954 return result; 7955 } 7956 7957 // UNPACK 7958 fir::ExtendedValue 7959 IntrinsicLibrary::genUnpack(mlir::Type resultType, 7960 llvm::ArrayRef<fir::ExtendedValue> args) { 7961 assert(args.size() == 3); 7962 7963 // Handle required vector argument 7964 mlir::Value vector = builder.createBox(loc, args[0]); 7965 7966 // Handle required mask argument 7967 fir::BoxValue maskBox = builder.createBox(loc, args[1]); 7968 mlir::Value mask = fir::getBase(maskBox); 7969 unsigned maskRank = maskBox.rank(); 7970 7971 // Handle required field argument 7972 mlir::Value field = builder.createBox(loc, args[2]); 7973 7974 // Create mutable fir.box to be passed to the runtime for the result. 7975 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank); 7976 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( 7977 builder, loc, resultArrayType, {}, 7978 fir::isPolymorphicType(vector.getType()) ? vector : mlir::Value{}); 7979 mlir::Value resultIrBox = 7980 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 7981 7982 fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field); 7983 7984 return readAndAddCleanUp(resultMutableBox, resultType, "UNPACK"); 7985 } 7986 7987 // VERIFY 7988 fir::ExtendedValue 7989 IntrinsicLibrary::genVerify(mlir::Type resultType, 7990 llvm::ArrayRef<fir::ExtendedValue> args) { 7991 7992 assert(args.size() == 4); 7993 7994 if (isStaticallyAbsent(args[3])) { 7995 // Kind not specified, so call scan/verify runtime routine that is 7996 // specialized on the kind of characters in string. 7997 7998 // Handle required string base arg 7999 mlir::Value stringBase = fir::getBase(args[0]); 8000 8001 // Handle required set string base arg 8002 mlir::Value setBase = fir::getBase(args[1]); 8003 8004 // Handle kind argument; it is the kind of character in this case 8005 fir::KindTy kind = 8006 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind( 8007 stringBase.getType()); 8008 8009 // Get string length argument 8010 mlir::Value stringLen = fir::getLen(args[0]); 8011 8012 // Get set string length argument 8013 mlir::Value setLen = fir::getLen(args[1]); 8014 8015 // Handle optional back argument 8016 mlir::Value back = 8017 isStaticallyAbsent(args[2]) 8018 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0) 8019 : fir::getBase(args[2]); 8020 8021 return builder.createConvert( 8022 loc, resultType, 8023 fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen, 8024 setBase, setLen, back)); 8025 } 8026 // else use the runtime descriptor version of scan/verify 8027 8028 // Handle optional argument, back 8029 auto makeRefThenEmbox = [&](mlir::Value b) { 8030 fir::LogicalType logTy = fir::LogicalType::get( 8031 builder.getContext(), builder.getKindMap().defaultLogicalKind()); 8032 mlir::Value temp = builder.createTemporary(loc, logTy); 8033 mlir::Value castb = builder.createConvert(loc, logTy, b); 8034 builder.create<fir::StoreOp>(loc, castb, temp); 8035 return builder.createBox(loc, temp); 8036 }; 8037 mlir::Value back = fir::isUnboxedValue(args[2]) 8038 ? makeRefThenEmbox(*args[2].getUnboxed()) 8039 : builder.create<fir::AbsentOp>( 8040 loc, fir::BoxType::get(builder.getI1Type())); 8041 8042 // Handle required string argument 8043 mlir::Value string = builder.createBox(loc, args[0]); 8044 8045 // Handle required set argument 8046 mlir::Value set = builder.createBox(loc, args[1]); 8047 8048 // Handle kind argument 8049 mlir::Value kind = fir::getBase(args[3]); 8050 8051 // Create result descriptor 8052 fir::MutableBoxValue resultMutableBox = 8053 fir::factory::createTempMutableBox(builder, loc, resultType); 8054 mlir::Value resultIrBox = 8055 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 8056 8057 fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set, 8058 back, kind); 8059 8060 // Handle cleanup of allocatable result descriptor and return 8061 return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY"); 8062 } 8063 8064 /// Process calls to Minloc, Maxloc intrinsic functions 8065 template <typename FN, typename FD> 8066 fir::ExtendedValue 8067 IntrinsicLibrary::genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg, 8068 mlir::Type resultType, 8069 llvm::ArrayRef<fir::ExtendedValue> args) { 8070 8071 assert(args.size() == 5); 8072 8073 // Handle required array argument 8074 mlir::Value array = builder.createBox(loc, args[0]); 8075 unsigned rank = fir::BoxValue(array).rank(); 8076 assert(rank >= 1); 8077 8078 // Handle optional mask argument 8079 auto mask = isStaticallyAbsent(args[2]) 8080 ? builder.create<fir::AbsentOp>( 8081 loc, fir::BoxType::get(builder.getI1Type())) 8082 : builder.createBox(loc, args[2]); 8083 8084 // Handle optional kind argument 8085 auto kind = isStaticallyAbsent(args[3]) 8086 ? builder.createIntegerConstant( 8087 loc, builder.getIndexType(), 8088 builder.getKindMap().defaultIntegerKind()) 8089 : fir::getBase(args[3]); 8090 8091 // Handle optional back argument 8092 auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false) 8093 : fir::getBase(args[4]); 8094 8095 bool absentDim = isStaticallyAbsent(args[1]); 8096 8097 if (!absentDim && rank == 1) { 8098 // If dim argument is present and the array is rank 1, then the result is 8099 // a scalar (since the the result is rank-1 or 0). 8100 // Therefore, we use a scalar result descriptor with Min/MaxlocDim(). 8101 mlir::Value dim = fir::getBase(args[1]); 8102 // Create mutable fir.box to be passed to the runtime for the result. 8103 fir::MutableBoxValue resultMutableBox = 8104 fir::factory::createTempMutableBox(builder, loc, resultType); 8105 mlir::Value resultIrBox = 8106 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 8107 8108 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back); 8109 8110 // Handle cleanup of allocatable result descriptor and return 8111 return readAndAddCleanUp(resultMutableBox, resultType, errMsg); 8112 } 8113 8114 // Note: The Min/Maxloc/val cases below have an array result. 8115 8116 // Create mutable fir.box to be passed to the runtime for the result. 8117 mlir::Type resultArrayType = 8118 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1); 8119 fir::MutableBoxValue resultMutableBox = 8120 fir::factory::createTempMutableBox(builder, loc, resultArrayType); 8121 mlir::Value resultIrBox = 8122 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 8123 8124 if (absentDim) { 8125 // Handle min/maxloc/val case where there is no dim argument 8126 // (calls Min/Maxloc()/MinMaxval() runtime routine) 8127 func(builder, loc, resultIrBox, array, mask, kind, back); 8128 } else { 8129 // else handle min/maxloc case with dim argument (calls 8130 // Min/Max/loc/val/Dim() runtime routine). 8131 mlir::Value dim = fir::getBase(args[1]); 8132 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back); 8133 } 8134 return readAndAddCleanUp(resultMutableBox, resultType, errMsg); 8135 } 8136 8137 // MAXLOC 8138 fir::ExtendedValue 8139 IntrinsicLibrary::genMaxloc(mlir::Type resultType, 8140 llvm::ArrayRef<fir::ExtendedValue> args) { 8141 return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim, 8142 "MAXLOC", resultType, args); 8143 } 8144 8145 /// Process calls to Maxval and Minval 8146 template <typename FN, typename FD, typename FC> 8147 fir::ExtendedValue 8148 IntrinsicLibrary::genExtremumVal(FN func, FD funcDim, FC funcChar, 8149 llvm::StringRef errMsg, mlir::Type resultType, 8150 llvm::ArrayRef<fir::ExtendedValue> args) { 8151 8152 assert(args.size() == 3); 8153 8154 // Handle required array argument 8155 fir::BoxValue arryTmp = builder.createBox(loc, args[0]); 8156 mlir::Value array = fir::getBase(arryTmp); 8157 int rank = arryTmp.rank(); 8158 assert(rank >= 1); 8159 bool hasCharacterResult = arryTmp.isCharacter(); 8160 8161 // Handle optional mask argument 8162 auto mask = isStaticallyAbsent(args[2]) 8163 ? builder.create<fir::AbsentOp>( 8164 loc, fir::BoxType::get(builder.getI1Type())) 8165 : builder.createBox(loc, args[2]); 8166 8167 bool absentDim = isStaticallyAbsent(args[1]); 8168 8169 // For Maxval/MinVal, we call the type specific versions of 8170 // Maxval/Minval because the result is scalar in the case below. 8171 if (!hasCharacterResult && (absentDim || rank == 1)) 8172 return func(builder, loc, array, mask); 8173 8174 if (hasCharacterResult && (absentDim || rank == 1)) { 8175 // Create mutable fir.box to be passed to the runtime for the result. 8176 fir::MutableBoxValue resultMutableBox = 8177 fir::factory::createTempMutableBox(builder, loc, resultType); 8178 mlir::Value resultIrBox = 8179 fir::factory::getMutableIRBox(builder, loc, resultMutableBox); 8180 8181 funcChar(builder, loc, resultIrBox, array, mask); 8182 8183 // Handle cleanup of allocatable result descriptor and return 8184 return readAndAddCleanUp(resultMutableBox, resultType, errMsg); 8185 } 8186 8187 // Handle Min/Maxval cases that have an array result. 8188 auto resultMutableBox = 8189 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank); 8190 return readAndAddCleanUp(resultMutableBox, resultType, errMsg); 8191 } 8192 8193 // MAXVAL 8194 fir::ExtendedValue 8195 IntrinsicLibrary::genMaxval(mlir::Type resultType, 8196 llvm::ArrayRef<fir::ExtendedValue> args) { 8197 return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim, 8198 fir::runtime::genMaxvalChar, "MAXVAL", resultType, 8199 args); 8200 } 8201 8202 // MINLOC 8203 fir::ExtendedValue 8204 IntrinsicLibrary::genMinloc(mlir::Type resultType, 8205 llvm::ArrayRef<fir::ExtendedValue> args) { 8206 return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim, 8207 "MINLOC", resultType, args); 8208 } 8209 8210 // MINVAL 8211 fir::ExtendedValue 8212 IntrinsicLibrary::genMinval(mlir::Type resultType, 8213 llvm::ArrayRef<fir::ExtendedValue> args) { 8214 return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim, 8215 fir::runtime::genMinvalChar, "MINVAL", resultType, 8216 args); 8217 } 8218 8219 // MIN and MAX 8220 template <Extremum extremum, ExtremumBehavior behavior> 8221 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, 8222 llvm::ArrayRef<mlir::Value> args) { 8223 assert(args.size() >= 1); 8224 mlir::Value result = args[0]; 8225 for (auto arg : args.drop_front()) { 8226 mlir::Value mask = 8227 createExtremumCompare<extremum, behavior>(loc, builder, result, arg); 8228 result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg); 8229 } 8230 return result; 8231 } 8232 8233 //===----------------------------------------------------------------------===// 8234 // Argument lowering rules interface for intrinsic or intrinsic module 8235 // procedure. 8236 //===----------------------------------------------------------------------===// 8237 8238 const IntrinsicArgumentLoweringRules * 8239 getIntrinsicArgumentLowering(llvm::StringRef specificName) { 8240 llvm::StringRef name = genericName(specificName); 8241 if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) 8242 if (!handler->argLoweringRules.hasDefaultRules()) 8243 return &handler->argLoweringRules; 8244 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name)) 8245 if (!ppcHandler->argLoweringRules.hasDefaultRules()) 8246 return &ppcHandler->argLoweringRules; 8247 return nullptr; 8248 } 8249 8250 const IntrinsicArgumentLoweringRules * 8251 IntrinsicHandlerEntry::getArgumentLoweringRules() const { 8252 if (const IntrinsicHandler *const *handler = 8253 std::get_if<const IntrinsicHandler *>(&entry)) { 8254 assert(*handler); 8255 if (!(*handler)->argLoweringRules.hasDefaultRules()) 8256 return &(*handler)->argLoweringRules; 8257 } 8258 return nullptr; 8259 } 8260 8261 /// Return how argument \p argName should be lowered given the rules for the 8262 /// intrinsic function. 8263 fir::ArgLoweringRule 8264 lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &rules, 8265 unsigned position) { 8266 assert(position < sizeof(rules.args) / (sizeof(decltype(*rules.args))) && 8267 "invalid argument"); 8268 return {rules.args[position].lowerAs, 8269 rules.args[position].handleDynamicOptional}; 8270 } 8271 8272 //===----------------------------------------------------------------------===// 8273 // Public intrinsic call helpers 8274 //===----------------------------------------------------------------------===// 8275 8276 std::pair<fir::ExtendedValue, bool> 8277 genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc, 8278 llvm::StringRef name, std::optional<mlir::Type> resultType, 8279 llvm::ArrayRef<fir::ExtendedValue> args, 8280 Fortran::lower::AbstractConverter *converter) { 8281 return IntrinsicLibrary{builder, loc, converter}.genIntrinsicCall( 8282 name, resultType, args); 8283 } 8284 8285 mlir::Value genMax(fir::FirOpBuilder &builder, mlir::Location loc, 8286 llvm::ArrayRef<mlir::Value> args) { 8287 assert(args.size() > 0 && "max requires at least one argument"); 8288 return IntrinsicLibrary{builder, loc} 8289 .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(), 8290 args); 8291 } 8292 8293 mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc, 8294 llvm::ArrayRef<mlir::Value> args) { 8295 assert(args.size() > 0 && "min requires at least one argument"); 8296 return IntrinsicLibrary{builder, loc} 8297 .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(), 8298 args); 8299 } 8300 8301 mlir::Value genDivC(fir::FirOpBuilder &builder, mlir::Location loc, 8302 mlir::Type type, mlir::Value x, mlir::Value y) { 8303 return IntrinsicLibrary{builder, loc}.genRuntimeCall("divc", type, {x, y}); 8304 } 8305 8306 mlir::Value genPow(fir::FirOpBuilder &builder, mlir::Location loc, 8307 mlir::Type type, mlir::Value x, mlir::Value y) { 8308 // TODO: since there is no libm version of pow with integer exponent, 8309 // we have to provide an alternative implementation for 8310 // "precise/strict" FP mode. 8311 // One option is to generate internal function with inlined 8312 // implementation and mark it 'strictfp'. 8313 // Another option is to implement it in Fortran runtime library 8314 // (just like matmul). 8315 return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y}); 8316 } 8317 8318 mlir::SymbolRefAttr 8319 getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &builder, 8320 mlir::Location loc, llvm::StringRef name, 8321 mlir::FunctionType signature) { 8322 return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr( 8323 name, signature); 8324 } 8325 } // namespace fir 8326