8911 lines · cpp
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-exception6//7//===----------------------------------------------------------------------===//8//9// Helper routines for constructing the FIR dialect of MLIR. As FIR is a10// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding11// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this12// 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/CUDAIntrinsicCall.h"20#include "flang/Optimizer/Builder/CUFCommon.h"21#include "flang/Optimizer/Builder/Character.h"22#include "flang/Optimizer/Builder/Complex.h"23#include "flang/Optimizer/Builder/FIRBuilder.h"24#include "flang/Optimizer/Builder/MutableBox.h"25#include "flang/Optimizer/Builder/PPCIntrinsicCall.h"26#include "flang/Optimizer/Builder/Runtime/Allocatable.h"27#include "flang/Optimizer/Builder/Runtime/CUDA/Descriptor.h"28#include "flang/Optimizer/Builder/Runtime/Character.h"29#include "flang/Optimizer/Builder/Runtime/Command.h"30#include "flang/Optimizer/Builder/Runtime/Derived.h"31#include "flang/Optimizer/Builder/Runtime/Exceptions.h"32#include "flang/Optimizer/Builder/Runtime/Execute.h"33#include "flang/Optimizer/Builder/Runtime/Inquiry.h"34#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"35#include "flang/Optimizer/Builder/Runtime/Numeric.h"36#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"37#include "flang/Optimizer/Builder/Runtime/Reduction.h"38#include "flang/Optimizer/Builder/Runtime/Stop.h"39#include "flang/Optimizer/Builder/Runtime/Transformational.h"40#include "flang/Optimizer/Builder/Todo.h"41#include "flang/Optimizer/Dialect/FIROps.h"42#include "flang/Optimizer/Dialect/FIROpsSupport.h"43#include "flang/Optimizer/Dialect/MIF/MIFOps.h"44#include "flang/Optimizer/Dialect/Support/FIRContext.h"45#include "flang/Optimizer/HLFIR/HLFIROps.h"46#include "flang/Optimizer/Support/FatalError.h"47#include "flang/Optimizer/Support/Utils.h"48#include "flang/Runtime/entry-names.h"49#include "flang/Runtime/iostat-consts.h"50#include "mlir/Dialect/Complex/IR/Complex.h"51#include "mlir/Dialect/LLVMIR/LLVMDialect.h"52#include "mlir/Dialect/LLVMIR/LLVMTypes.h"53#include "mlir/Dialect/Math/IR/Math.h"54#include "mlir/Dialect/Vector/IR/VectorOps.h"55#include "llvm/Support/CommandLine.h"56#include "llvm/Support/Debug.h"57#include "llvm/Support/MathExtras.h"58#include "llvm/Support/raw_ostream.h"59#include <cfenv> // temporary -- only used in genIeeeGetOrSetModesOrStatus60#include <optional>61 62#define DEBUG_TYPE "flang-lower-intrinsic"63 64/// This file implements lowering of Fortran intrinsic procedures and Fortran65/// intrinsic module procedures. A call may be inlined with a mix of FIR and66/// MLIR operations, or as a call to a runtime function or LLVM intrinsic.67 68/// Lowering of intrinsic procedure calls is based on a map that associates69/// Fortran intrinsic generic names to FIR generator functions.70/// All generator functions are member functions of the IntrinsicLibrary class71/// and have the same interface.72/// If no generator is given for an intrinsic name, a math runtime library73/// is searched for an implementation and, if a runtime function is found,74/// a call is generated for it. LLVM intrinsics are handled as a math75/// runtime library here.76 77namespace fir {78 79fir::ExtendedValue getAbsentIntrinsicArgument() { return fir::UnboxedValue{}; }80 81/// Test if an ExtendedValue is absent. This is used to test if an intrinsic82/// argument are absent at compile time.83static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {84 return !fir::getBase(exv);85}86static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,87 size_t argIndex) {88 return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);89}90static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,91 size_t argIndex) {92 return args.size() <= argIndex || !args[argIndex];93}94static bool isOptional(mlir::Value value) {95 auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>(96 value.getDefiningOp());97 return varIface && varIface.isOptional();98}99 100/// Test if an ExtendedValue is present. This is used to test if an intrinsic101/// argument is present at compile time. This does not imply that the related102/// value may not be an absent dummy optional, disassociated pointer, or a103/// deallocated allocatable. See `handleDynamicOptional` to deal with these104/// cases when it makes sense.105static bool isStaticallyPresent(const fir::ExtendedValue &exv) {106 return !isStaticallyAbsent(exv);107}108 109using I = IntrinsicLibrary;110 111/// Flag to indicate that an intrinsic argument has to be handled as112/// being dynamically optional (e.g. special handling when actual113/// argument is an optional variable in the current scope).114static constexpr bool handleDynamicOptional = true;115 116/// Table that drives the fir generation depending on the intrinsic or intrinsic117/// module procedure one to one mapping with Fortran arguments. If no mapping is118/// defined here for a generic intrinsic, genRuntimeCall will be called119/// to look for a match in the runtime and emit a call. Note that the argument120/// lowering rules for an intrinsic need to be provided only if at least one121/// argument must not be lowered by value. In which case, the lowering rules122/// should be provided for all the intrinsic arguments for completeness.123static constexpr IntrinsicHandler handlers[]{124 {"abort", &I::genAbort},125 {"abs", &I::genAbs},126 {"achar", &I::genChar},127 {"acosd", &I::genAcosd},128 {"acospi", &I::genAcospi},129 {"adjustl",130 &I::genAdjustRtCall<fir::runtime::genAdjustL>,131 {{{"string", asAddr}}},132 /*isElemental=*/true},133 {"adjustr",134 &I::genAdjustRtCall<fir::runtime::genAdjustR>,135 {{{"string", asAddr}}},136 /*isElemental=*/true},137 {"aimag", &I::genAimag},138 {"aint", &I::genAint},139 {"all",140 &I::genAll,141 {{{"mask", asAddr}, {"dim", asValue}}},142 /*isElemental=*/false},143 {"allocated",144 &I::genAllocated,145 {{{"array", asInquired}, {"scalar", asInquired}}},146 /*isElemental=*/false},147 {"anint", &I::genAnint},148 {"any",149 &I::genAny,150 {{{"mask", asAddr}, {"dim", asValue}}},151 /*isElemental=*/false},152 {"asind", &I::genAsind},153 {"asinpi", &I::genAsinpi},154 {"associated",155 &I::genAssociated,156 {{{"pointer", asInquired}, {"target", asInquired}}},157 /*isElemental=*/false},158 {"atan2d", &I::genAtand},159 {"atan2pi", &I::genAtanpi},160 {"atand", &I::genAtand},161 {"atanpi", &I::genAtanpi},162 {"bessel_jn",163 &I::genBesselJn,164 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},165 /*isElemental=*/false},166 {"bessel_yn",167 &I::genBesselYn,168 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},169 /*isElemental=*/false},170 {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},171 {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},172 {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},173 {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},174 {"btest", &I::genBtest},175 {"c_associated_c_funptr",176 &I::genCAssociatedCFunPtr,177 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},178 /*isElemental=*/false},179 {"c_associated_c_ptr",180 &I::genCAssociatedCPtr,181 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},182 /*isElemental=*/false},183 {"c_devloc", &I::genCDevLoc, {{{"x", asBox}}}, /*isElemental=*/false},184 {"c_f_pointer",185 &I::genCFPointer,186 {{{"cptr", asValue},187 {"fptr", asInquired},188 {"shape", asAddr, handleDynamicOptional},189 {"lower", asAddr, handleDynamicOptional}}},190 /*isElemental=*/false},191 {"c_f_procpointer",192 &I::genCFProcPointer,193 {{{"cptr", asValue}, {"fptr", asInquired}}},194 /*isElemental=*/false},195 {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},196 {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},197 {"c_ptr_eq", &I::genCPtrCompare<mlir::arith::CmpIPredicate::eq>},198 {"c_ptr_ne", &I::genCPtrCompare<mlir::arith::CmpIPredicate::ne>},199 {"ceiling", &I::genCeiling},200 {"char", &I::genChar},201 {"chdir",202 &I::genChdir,203 {{{"name", asAddr}, {"status", asAddr, handleDynamicOptional}}},204 /*isElemental=*/false},205 {"cmplx",206 &I::genCmplx,207 {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},208 {"co_broadcast",209 &I::genCoBroadcast,210 {{{"a", asBox},211 {"source_image", asValue},212 {"stat", asAddr, handleDynamicOptional},213 {"errmsg", asBox, handleDynamicOptional}}},214 /*isElemental*/ false},215 {"co_max",216 &I::genCoMax,217 {{{"a", asBox},218 {"result_image", asValue, handleDynamicOptional},219 {"stat", asAddr, handleDynamicOptional},220 {"errmsg", asBox, handleDynamicOptional}}},221 /*isElemental*/ false},222 {"co_min",223 &I::genCoMin,224 {{{"a", asBox},225 {"result_image", asValue, handleDynamicOptional},226 {"stat", asAddr, handleDynamicOptional},227 {"errmsg", asBox, handleDynamicOptional}}},228 /*isElemental*/ false},229 {"co_sum",230 &I::genCoSum,231 {{{"a", asBox},232 {"result_image", asValue, handleDynamicOptional},233 {"stat", asAddr, handleDynamicOptional},234 {"errmsg", asBox, handleDynamicOptional}}},235 /*isElemental*/ false},236 {"command_argument_count", &I::genCommandArgumentCount},237 {"conjg", &I::genConjg},238 {"cosd", &I::genCosd},239 {"cospi", &I::genCospi},240 {"count",241 &I::genCount,242 {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},243 /*isElemental=*/false},244 {"cpu_time",245 &I::genCpuTime,246 {{{"time", asAddr}}},247 /*isElemental=*/false},248 {"cshift",249 &I::genCshift,250 {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},251 /*isElemental=*/false},252 {"date_and_time",253 &I::genDateAndTime,254 {{{"date", asAddr, handleDynamicOptional},255 {"time", asAddr, handleDynamicOptional},256 {"zone", asAddr, handleDynamicOptional},257 {"values", asBox, handleDynamicOptional}}},258 /*isElemental=*/false},259 {"dble", &I::genConversion},260 {"dim", &I::genDim},261 {"dot_product",262 &I::genDotProduct,263 {{{"vector_a", asBox}, {"vector_b", asBox}}},264 /*isElemental=*/false},265 {"dprod", &I::genDprod},266 {"dsecnds",267 &I::genDsecnds,268 {{{"refTime", asAddr}}},269 /*isElemental=*/false},270 {"dshiftl", &I::genDshiftl},271 {"dshiftr", &I::genDshiftr},272 {"eoshift",273 &I::genEoshift,274 {{{"array", asBox},275 {"shift", asAddr},276 {"boundary", asBox, handleDynamicOptional},277 {"dim", asValue}}},278 /*isElemental=*/false},279 {"erfc_scaled", &I::genErfcScaled},280 {"etime",281 &I::genEtime,282 {{{"values", asBox}, {"time", asBox}}},283 /*isElemental=*/false},284 {"execute_command_line",285 &I::genExecuteCommandLine,286 {{{"command", asBox},287 {"wait", asAddr, handleDynamicOptional},288 {"exitstat", asBox, handleDynamicOptional},289 {"cmdstat", asBox, handleDynamicOptional},290 {"cmdmsg", asBox, handleDynamicOptional}}},291 /*isElemental=*/false},292 {"exit",293 &I::genExit,294 {{{"status", asValue, handleDynamicOptional}}},295 /*isElemental=*/false},296 {"exponent", &I::genExponent},297 {"extends_type_of",298 &I::genExtendsTypeOf,299 {{{"a", asBox}, {"mold", asBox}}},300 /*isElemental=*/false},301 {"findloc",302 &I::genFindloc,303 {{{"array", asBox},304 {"value", asAddr},305 {"dim", asValue},306 {"mask", asBox, handleDynamicOptional},307 {"kind", asValue},308 {"back", asValue, handleDynamicOptional}}},309 /*isElemental=*/false},310 {"floor", &I::genFloor},311 {"flush",312 &I::genFlush,313 {{{"unit", asAddr}}},314 /*isElemental=*/false},315 {"fraction", &I::genFraction},316 {"free", &I::genFree},317 {"fseek",318 &I::genFseek,319 {{{"unit", asValue},320 {"offset", asValue},321 {"whence", asValue},322 {"status", asAddr, handleDynamicOptional}}},323 /*isElemental=*/false},324 {"ftell",325 &I::genFtell,326 {{{"unit", asValue}, {"offset", asAddr}}},327 /*isElemental=*/false},328 {"get_command",329 &I::genGetCommand,330 {{{"command", asBox, handleDynamicOptional},331 {"length", asBox, handleDynamicOptional},332 {"status", asAddr, handleDynamicOptional},333 {"errmsg", asBox, handleDynamicOptional}}},334 /*isElemental=*/false},335 {"get_command_argument",336 &I::genGetCommandArgument,337 {{{"number", asValue},338 {"value", asBox, handleDynamicOptional},339 {"length", asBox, handleDynamicOptional},340 {"status", asAddr, handleDynamicOptional},341 {"errmsg", asBox, handleDynamicOptional}}},342 /*isElemental=*/false},343 {"get_environment_variable",344 &I::genGetEnvironmentVariable,345 {{{"name", asBox},346 {"value", asBox, handleDynamicOptional},347 {"length", asBox, handleDynamicOptional},348 {"status", asAddr, handleDynamicOptional},349 {"trim_name", asAddr, handleDynamicOptional},350 {"errmsg", asBox, handleDynamicOptional}}},351 /*isElemental=*/false},352 {"get_team",353 &I::genGetTeam,354 {{{"level", asValue, handleDynamicOptional}}},355 /*isElemental=*/false},356 {"getcwd",357 &I::genGetCwd,358 {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},359 /*isElemental=*/false},360 {"getgid", &I::genGetGID},361 {"getpid", &I::genGetPID},362 {"getuid", &I::genGetUID},363 {"hostnm",364 &I::genHostnm,365 {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},366 /*isElemental=*/false},367 {"iachar", &I::genIchar},368 {"iall",369 &I::genIall,370 {{{"array", asBox},371 {"dim", asValue},372 {"mask", asBox, handleDynamicOptional}}},373 /*isElemental=*/false},374 {"iand", &I::genIand},375 {"iany",376 &I::genIany,377 {{{"array", asBox},378 {"dim", asValue},379 {"mask", asBox, handleDynamicOptional}}},380 /*isElemental=*/false},381 {"ibclr", &I::genIbclr},382 {"ibits", &I::genIbits},383 {"ibset", &I::genIbset},384 {"ichar", &I::genIchar},385 {"ieee_class", &I::genIeeeClass},386 {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},387 {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},388 {"ieee_copy_sign", &I::genIeeeCopySign},389 {"ieee_get_flag",390 &I::genIeeeGetFlag,391 {{{"flag", asValue}, {"flag_value", asAddr}}}},392 {"ieee_get_halting_mode",393 &I::genIeeeGetHaltingMode,394 {{{"flag", asValue}, {"halting", asAddr}}}},395 {"ieee_get_modes",396 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/true>},397 {"ieee_get_rounding_mode",398 &I::genIeeeGetRoundingMode,399 {{{"round_value", asAddr, handleDynamicOptional},400 {"radix", asValue, handleDynamicOptional}}},401 /*isElemental=*/false},402 {"ieee_get_status",403 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/false>},404 {"ieee_get_underflow_mode",405 &I::genIeeeGetUnderflowMode,406 {{{"gradual", asAddr}}},407 /*isElemental=*/false},408 {"ieee_int", &I::genIeeeInt},409 {"ieee_is_finite", &I::genIeeeIsFinite},410 {"ieee_is_nan", &I::genIeeeIsNan},411 {"ieee_is_negative", &I::genIeeeIsNegative},412 {"ieee_is_normal", &I::genIeeeIsNormal},413 {"ieee_logb", &I::genIeeeLogb},414 {"ieee_max",415 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/false>},416 {"ieee_max_mag",417 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/true>},418 {"ieee_max_num",419 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/false>},420 {"ieee_max_num_mag",421 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/true>},422 {"ieee_min",423 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/false>},424 {"ieee_min_mag",425 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/true>},426 {"ieee_min_num",427 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>},428 {"ieee_min_num_mag",429 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>},430 {"ieee_next_after", &I::genNearest<I::NearestProc::NextAfter>},431 {"ieee_next_down", &I::genNearest<I::NearestProc::NextDown>},432 {"ieee_next_up", &I::genNearest<I::NearestProc::NextUp>},433 {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>},434 {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>},435 {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>},436 {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>},437 {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>},438 {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>},439 {"ieee_real", &I::genIeeeReal},440 {"ieee_rem", &I::genIeeeRem},441 {"ieee_rint", &I::genIeeeRint},442 {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},443 {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},444 {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},445 {"ieee_set_halting_mode",446 &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>},447 {"ieee_set_modes",448 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/true>},449 {"ieee_set_rounding_mode",450 &I::genIeeeSetRoundingMode,451 {{{"round_value", asValue, handleDynamicOptional},452 {"radix", asValue, handleDynamicOptional}}},453 /*isElemental=*/false},454 {"ieee_set_status",455 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/false>},456 {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode},457 {"ieee_signaling_eq",458 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},459 {"ieee_signaling_ge",460 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGE>},461 {"ieee_signaling_gt",462 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGT>},463 {"ieee_signaling_le",464 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLE>},465 {"ieee_signaling_lt",466 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLT>},467 {"ieee_signaling_ne",468 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},469 {"ieee_signbit", &I::genIeeeSignbit},470 {"ieee_support_flag",471 &I::genIeeeSupportFlag,472 {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},473 /*isElemental=*/false},474 {"ieee_support_halting",475 &I::genIeeeSupportHalting,476 {{{"flag", asValue}}},477 /*isElemental=*/false},478 {"ieee_support_rounding",479 &I::genIeeeSupportRounding,480 {{{"round_value", asValue}, {"x", asInquired, handleDynamicOptional}}},481 /*isElemental=*/false},482 {"ieee_support_standard",483 &I::genIeeeSupportStandard,484 {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},485 /*isElemental=*/false},486 {"ieee_unordered", &I::genIeeeUnordered},487 {"ieee_value", &I::genIeeeValue},488 {"ieor", &I::genIeor},489 {"index",490 &I::genIndex,491 {{{"string", asAddr},492 {"substring", asAddr},493 {"back", asValue, handleDynamicOptional},494 {"kind", asValue}}}},495 {"ior", &I::genIor},496 {"iparity",497 &I::genIparity,498 {{{"array", asBox},499 {"dim", asValue},500 {"mask", asBox, handleDynamicOptional}}},501 /*isElemental=*/false},502 {"is_contiguous",503 &I::genIsContiguous,504 {{{"array", asBox}}},505 /*isElemental=*/false},506 {"is_iostat_end", &I::genIsIostatValue<Fortran::runtime::io::IostatEnd>},507 {"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>},508 {"ishft", &I::genIshft},509 {"ishftc", &I::genIshftc},510 {"isnan", &I::genIeeeIsNan},511 {"lbound",512 &I::genLbound,513 {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},514 /*isElemental=*/false},515 {"leadz", &I::genLeadz},516 {"len",517 &I::genLen,518 {{{"string", asInquired}, {"kind", asValue}}},519 /*isElemental=*/false},520 {"len_trim", &I::genLenTrim},521 {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},522 {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},523 {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},524 {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},525 {"lnblnk", &I::genLenTrim},526 {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false},527 {"malloc", &I::genMalloc},528 {"maskl", &I::genMask<mlir::arith::ShLIOp>},529 {"maskr", &I::genMask<mlir::arith::ShRUIOp>},530 {"matmul",531 &I::genMatmul,532 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},533 /*isElemental=*/false},534 {"matmul_transpose",535 &I::genMatmulTranspose,536 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},537 /*isElemental=*/false},538 {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},539 {"maxloc",540 &I::genMaxloc,541 {{{"array", asBox},542 {"dim", asValue},543 {"mask", asBox, handleDynamicOptional},544 {"kind", asValue},545 {"back", asValue, handleDynamicOptional}}},546 /*isElemental=*/false},547 {"maxval",548 &I::genMaxval,549 {{{"array", asBox},550 {"dim", asValue},551 {"mask", asBox, handleDynamicOptional}}},552 /*isElemental=*/false},553 {"merge", &I::genMerge},554 {"merge_bits", &I::genMergeBits},555 {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},556 {"minloc",557 &I::genMinloc,558 {{{"array", asBox},559 {"dim", asValue},560 {"mask", asBox, handleDynamicOptional},561 {"kind", asValue},562 {"back", asValue, handleDynamicOptional}}},563 /*isElemental=*/false},564 {"minval",565 &I::genMinval,566 {{{"array", asBox},567 {"dim", asValue},568 {"mask", asBox, handleDynamicOptional}}},569 /*isElemental=*/false},570 {"mod", &I::genMod},571 {"modulo", &I::genModulo},572 {"move_alloc",573 &I::genMoveAlloc,574 {{{"from", asInquired},575 {"to", asInquired},576 {"status", asAddr, handleDynamicOptional},577 {"errMsg", asBox, handleDynamicOptional}}},578 /*isElemental=*/false},579 {"mvbits",580 &I::genMvbits,581 {{{"from", asValue},582 {"frompos", asValue},583 {"len", asValue},584 {"to", asAddr},585 {"topos", asValue}}}},586 {"nearest", &I::genNearest<I::NearestProc::Nearest>},587 {"nint", &I::genNint},588 {"norm2",589 &I::genNorm2,590 {{{"array", asBox}, {"dim", asValue}}},591 /*isElemental=*/false},592 {"not", &I::genNot},593 {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},594 {"num_images",595 &I::genNumImages,596 {{{"team_number", asValue}, {"team", asBox}}},597 /*isElemental*/ false},598 {"pack",599 &I::genPack,600 {{{"array", asBox},601 {"mask", asBox},602 {"vector", asBox, handleDynamicOptional}}},603 /*isElemental=*/false},604 {"parity",605 &I::genParity,606 {{{"mask", asBox}, {"dim", asValue}}},607 /*isElemental=*/false},608 {"perror",609 &I::genPerror,610 {{{"string", asBox}}},611 /*isElemental*/ false},612 {"popcnt", &I::genPopcnt},613 {"poppar", &I::genPoppar},614 {"present",615 &I::genPresent,616 {{{"a", asInquired}}},617 /*isElemental=*/false},618 {"product",619 &I::genProduct,620 {{{"array", asBox},621 {"dim", asValue},622 {"mask", asBox, handleDynamicOptional}}},623 /*isElemental=*/false},624 {"putenv",625 &I::genPutenv,626 {{{"str", asAddr}, {"status", asAddr, handleDynamicOptional}}},627 /*isElemental=*/false},628 {"random_init",629 &I::genRandomInit,630 {{{"repeatable", asValue}, {"image_distinct", asValue}}},631 /*isElemental=*/false},632 {"random_number",633 &I::genRandomNumber,634 {{{"harvest", asBox}}},635 /*isElemental=*/false},636 {"random_seed",637 &I::genRandomSeed,638 {{{"size", asBox, handleDynamicOptional},639 {"put", asBox, handleDynamicOptional},640 {"get", asBox, handleDynamicOptional}}},641 /*isElemental=*/false},642 {"reduce",643 &I::genReduce,644 {{{"array", asBox},645 {"operation", asAddr},646 {"dim", asValue},647 {"mask", asBox, handleDynamicOptional},648 {"identity", asAddr, handleDynamicOptional},649 {"ordered", asValue, handleDynamicOptional}}},650 /*isElemental=*/false},651 {"rename",652 &I::genRename,653 {{{"path1", asBox},654 {"path2", asBox},655 {"status", asBox, handleDynamicOptional}}},656 /*isElemental=*/false},657 {"repeat",658 &I::genRepeat,659 {{{"string", asAddr}, {"ncopies", asValue}}},660 /*isElemental=*/false},661 {"reshape",662 &I::genReshape,663 {{{"source", asBox},664 {"shape", asBox},665 {"pad", asBox, handleDynamicOptional},666 {"order", asBox, handleDynamicOptional}}},667 /*isElemental=*/false},668 {"rrspacing", &I::genRRSpacing},669 {"same_type_as",670 &I::genSameTypeAs,671 {{{"a", asBox}, {"b", asBox}}},672 /*isElemental=*/false},673 {"scale",674 &I::genScale,675 {{{"x", asValue}, {"i", asValue}}},676 /*isElemental=*/true},677 {"scan",678 &I::genScan,679 {{{"string", asAddr},680 {"set", asAddr},681 {"back", asValue, handleDynamicOptional},682 {"kind", asValue}}},683 /*isElemental=*/true},684 {"secnds",685 &I::genSecnds,686 {{{"refTime", asAddr}}},687 /*isElemental=*/false},688 {"second",689 &I::genSecond,690 {{{"time", asAddr}}},691 /*isElemental=*/false},692 {"selected_char_kind",693 &I::genSelectedCharKind,694 {{{"name", asAddr}}},695 /*isElemental=*/false},696 {"selected_int_kind",697 &I::genSelectedIntKind,698 {{{"scalar", asAddr}}},699 /*isElemental=*/false},700 {"selected_logical_kind",701 &I::genSelectedLogicalKind,702 {{{"bits", asAddr}}},703 /*isElemental=*/false},704 {"selected_real_kind",705 &I::genSelectedRealKind,706 {{{"precision", asAddr, handleDynamicOptional},707 {"range", asAddr, handleDynamicOptional},708 {"radix", asAddr, handleDynamicOptional}}},709 /*isElemental=*/false},710 {"selected_unsigned_kind",711 &I::genSelectedIntKind, // same results as selected_int_kind712 {{{"scalar", asAddr}}},713 /*isElemental=*/false},714 {"set_exponent", &I::genSetExponent},715 {"shape",716 &I::genShape,717 {{{"source", asBox}, {"kind", asValue}}},718 /*isElemental=*/false},719 {"shifta", &I::genShiftA},720 {"shiftl", &I::genShift<mlir::arith::ShLIOp>},721 {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},722 {"show_descriptor",723 &I::genShowDescriptor,724 {{{"d", asBox}}},725 /*isElemental=*/false},726 {"sign", &I::genSign},727 {"signal",728 &I::genSignalSubroutine,729 {{{"number", asValue}, {"handler", asAddr}, {"status", asAddr}}},730 /*isElemental=*/false},731 {"sind", &I::genSind},732 {"sinpi", &I::genSinpi},733 {"size",734 &I::genSize,735 {{{"array", asBox},736 {"dim", asAddr, handleDynamicOptional},737 {"kind", asValue}}},738 /*isElemental=*/false},739 {"sizeof",740 &I::genSizeOf,741 {{{"a", asBox}}},742 /*isElemental=*/false},743 {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false},744 {"spacing", &I::genSpacing},745 {"spread",746 &I::genSpread,747 {{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}},748 /*isElemental=*/false},749 {"storage_size",750 &I::genStorageSize,751 {{{"a", asInquired}, {"kind", asValue}}},752 /*isElemental=*/false},753 {"sum",754 &I::genSum,755 {{{"array", asBox},756 {"dim", asValue},757 {"mask", asBox, handleDynamicOptional}}},758 /*isElemental=*/false},759 {"system",760 &I::genSystem,761 {{{"command", asBox}, {"exitstat", asBox, handleDynamicOptional}}},762 /*isElemental=*/false},763 {"system_clock",764 &I::genSystemClock,765 {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},766 /*isElemental=*/false},767 {"tand", &I::genTand},768 {"tanpi", &I::genTanpi},769 {"team_number",770 &I::genTeamNumber,771 {{{"team", asBox, handleDynamicOptional}}},772 /*isElemental=*/false},773 {"this_image",774 &I::genThisImage,775 {{{"coarray", asBox},776 {"dim", asAddr},777 {"team", asBox, handleDynamicOptional}}},778 /*isElemental=*/false},779 {"time", &I::genTime, {}, /*isElemental=*/false},780 {"trailz", &I::genTrailz},781 {"transfer",782 &I::genTransfer,783 {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},784 /*isElemental=*/false},785 {"transpose",786 &I::genTranspose,787 {{{"matrix", asAddr}}},788 /*isElemental=*/false},789 {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},790 {"ubound",791 &I::genUbound,792 {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},793 /*isElemental=*/false},794 {"umaskl", &I::genMask<mlir::arith::ShLIOp>},795 {"umaskr", &I::genMask<mlir::arith::ShRUIOp>},796 {"unlink",797 &I::genUnlink,798 {{{"path", asAddr}, {"status", asAddr, handleDynamicOptional}}},799 /*isElemental=*/false},800 {"unpack",801 &I::genUnpack,802 {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},803 /*isElemental=*/false},804 {"verify",805 &I::genVerify,806 {{{"string", asAddr},807 {"set", asAddr},808 {"back", asValue, handleDynamicOptional},809 {"kind", asValue}}},810 /*isElemental=*/true},811};812 813template <std::size_t N>814static constexpr bool isSorted(const IntrinsicHandler (&array)[N]) {815 // Replace by std::sorted when C++20 is default (will be constexpr).816 const IntrinsicHandler *lastSeen{nullptr};817 bool isSorted{true};818 for (const auto &x : array) {819 if (lastSeen)820 isSorted &= std::string_view{lastSeen->name} < std::string_view{x.name};821 lastSeen = &x;822 }823 return isSorted;824}825static_assert(isSorted(handlers) && "map must be sorted");826 827static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {828 auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {829 return name.compare(handler.name) > 0;830 };831 auto result = llvm::lower_bound(handlers, name, compare);832 return result != std::end(handlers) && result->name == name ? result833 : nullptr;834}835 836/// To make fir output more readable for debug, one can outline all intrinsic837/// implementation in wrappers (overrides the IntrinsicHandler::outline flag).838static llvm::cl::opt<bool> outlineAllIntrinsics(839 "outline-intrinsics",840 llvm::cl::desc(841 "Lower all intrinsic procedure implementation in their own functions"),842 llvm::cl::init(false));843 844//===----------------------------------------------------------------------===//845// Math runtime description and matching utility846//===----------------------------------------------------------------------===//847 848/// Command line option to modify math runtime behavior used to implement849/// intrinsics. This option applies both to early and late math-lowering modes.850enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion };851llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(852 "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),853 llvm::cl::values(854 clEnumValN(fastVersion, "fast", "use fast runtime behavior"),855 clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),856 clEnumValN(preciseVersion, "precise", "use precise runtime behavior")),857 llvm::cl::init(fastVersion));858 859static llvm::cl::opt<bool>860 forceMlirComplex("force-mlir-complex",861 llvm::cl::desc("Force using MLIR complex operations "862 "instead of libm complex operations"),863 llvm::cl::init(false));864 865/// Return a string containing the given Fortran intrinsic name866/// with the type of its arguments specified in funcType867/// surrounded by the given prefix/suffix.868static std::string869prettyPrintIntrinsicName(fir::FirOpBuilder &builder, mlir::Location loc,870 llvm::StringRef prefix, llvm::StringRef name,871 llvm::StringRef suffix, mlir::FunctionType funcType) {872 std::string output = prefix.str();873 llvm::raw_string_ostream sstream(output);874 if (name == "pow" || name == "pow-unsigned") {875 assert(funcType.getNumInputs() == 2 && "power operator has two arguments");876 std::string displayName{" ** "};877 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(0), loc,878 displayName)879 << displayName880 << mlirTypeToIntrinsicFortran(builder, funcType.getInput(1), loc,881 displayName);882 } else {883 sstream << name.upper() << "(";884 if (funcType.getNumInputs() > 0)885 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(0), loc,886 name);887 for (mlir::Type argType : funcType.getInputs().drop_front()) {888 sstream << ", "889 << mlirTypeToIntrinsicFortran(builder, argType, loc, name);890 }891 sstream << ")";892 }893 sstream << suffix;894 return output;895}896 897// Generate a call to the Fortran runtime library providing898// support for 128-bit float math.899// On 'HAS_LDBL128' targets the implementation900// is provided by flang_rt, otherwise, it is done via the901// libflang_rt.quadmath library. In the latter case the compiler902// has to be built with FLANG_RUNTIME_F128_MATH_LIB to guarantee903// proper linking actions in the driver.904static mlir::Value genLibF128Call(fir::FirOpBuilder &builder,905 mlir::Location loc,906 const MathOperation &mathOp,907 mlir::FunctionType libFuncType,908 llvm::ArrayRef<mlir::Value> args) {909 // TODO: if we knew that the C 'long double' does not have 113-bit mantissa910 // on the target, we could have asserted that FLANG_RUNTIME_F128_MATH_LIB911 // must be specified. For now just always generate the call even912 // if it will be unresolved.913 return genLibCall(builder, loc, mathOp, libFuncType, args);914}915 916mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,917 const MathOperation &mathOp,918 mlir::FunctionType libFuncType,919 llvm::ArrayRef<mlir::Value> args) {920 llvm::StringRef libFuncName = mathOp.runtimeFunc;921 922 // On AIX, __clog is used in libm.923 if (fir::getTargetTriple(builder.getModule()).isOSAIX() &&924 libFuncName == "clog") {925 libFuncName = "__clog";926 }927 928 LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName929 << "' call with type ";930 libFuncType.dump(); llvm::dbgs() << "\n");931 mlir::func::FuncOp funcOp = builder.getNamedFunction(libFuncName);932 933 if (!funcOp) {934 funcOp = builder.createFunction(loc, libFuncName, libFuncType);935 // C-interoperability rules apply to these library functions.936 funcOp->setAttr(fir::getSymbolAttrName(),937 mlir::StringAttr::get(builder.getContext(), libFuncName));938 // Set fir.runtime attribute to distinguish the function that939 // was just created from user functions with the same name.940 funcOp->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(),941 builder.getUnitAttr());942 auto libCall = fir::CallOp::create(builder, loc, funcOp, args);943 // TODO: ensure 'strictfp' setting on the call for "precise/strict"944 // FP mode. Set appropriate Fast-Math Flags otherwise.945 // TODO: we should also mark as many libm function as possible946 // with 'pure' attribute (of course, not in strict FP mode).947 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");948 return libCall.getResult(0);949 }950 951 // The function with the same name already exists.952 fir::CallOp libCall;953 mlir::Type soughtFuncType = funcOp.getFunctionType();954 955 if (soughtFuncType == libFuncType) {956 libCall = fir::CallOp::create(builder, loc, funcOp, args);957 } else {958 // A function with the same name might have been declared959 // before (e.g. with an explicit interface and a binding label).960 // It is in general incorrect to use the same definition for the library961 // call, but we have no other options. Type cast the function to match962 // the requested signature and generate an indirect call to avoid963 // later failures caused by the signature mismatch.964 LLVM_DEBUG(mlir::emitWarning(965 loc, llvm::Twine("function signature mismatch for '") +966 llvm::Twine(libFuncName) +967 llvm::Twine("' may lead to undefined behavior.")));968 mlir::SymbolRefAttr funcSymbolAttr = builder.getSymbolRefAttr(libFuncName);969 mlir::Value funcPointer =970 fir::AddrOfOp::create(builder, loc, soughtFuncType, funcSymbolAttr);971 funcPointer = builder.createConvert(loc, libFuncType, funcPointer);972 973 llvm::SmallVector<mlir::Value, 3> operands{funcPointer};974 operands.append(args.begin(), args.end());975 libCall = fir::CallOp::create(builder, loc, mlir::SymbolRefAttr{},976 libFuncType.getResults(), operands);977 }978 979 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");980 return libCall.getResult(0);981}982 983mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder,984 mlir::Location loc,985 const MathOperation &mathOp,986 mlir::FunctionType libFuncType,987 llvm::ArrayRef<mlir::Value> args) {988 assert(args.size() == 2 && "Incorrect #args to genLibSplitComplexArgsCall");989 990 auto getSplitComplexArgsType = [&builder, &args]() -> mlir::FunctionType {991 mlir::Type ctype = args[0].getType();992 auto ftype = mlir::cast<mlir::ComplexType>(ctype).getElementType();993 return builder.getFunctionType({ftype, ftype, ftype, ftype}, {ctype});994 };995 996 llvm::SmallVector<mlir::Value, 4> splitArgs;997 mlir::Value cplx1 = args[0];998 auto real1 = fir::factory::Complex{builder, loc}.extractComplexPart(999 cplx1, /*isImagPart=*/false);1000 splitArgs.push_back(real1);1001 auto imag1 = fir::factory::Complex{builder, loc}.extractComplexPart(1002 cplx1, /*isImagPart=*/true);1003 splitArgs.push_back(imag1);1004 mlir::Value cplx2 = args[1];1005 auto real2 = fir::factory::Complex{builder, loc}.extractComplexPart(1006 cplx2, /*isImagPart=*/false);1007 splitArgs.push_back(real2);1008 auto imag2 = fir::factory::Complex{builder, loc}.extractComplexPart(1009 cplx2, /*isImagPart=*/true);1010 splitArgs.push_back(imag2);1011 1012 return genLibCall(builder, loc, mathOp, getSplitComplexArgsType(), splitArgs);1013}1014 1015template <typename T>1016mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,1017 const MathOperation &mathOp,1018 mlir::FunctionType mathLibFuncType,1019 llvm::ArrayRef<mlir::Value> args) {1020 // TODO: we have to annotate the math operations with flags1021 // that will allow to define FP accuracy/exception1022 // behavior per operation, so that after early multi-module1023 // MLIR inlining we can distiguish operation that were1024 // compiled with different settings.1025 // Suggestion:1026 // * For "relaxed" FP mode set all Fast-Math Flags1027 // (see "[RFC] FastMath flags support in MLIR (arith dialect)"1028 // topic at discourse.llvm.org).1029 // * For "fast" FP mode set all Fast-Math Flags except 'afn'.1030 // * For "precise/strict" FP mode generate fir.calls to libm1031 // entries and annotate them with an attribute that will1032 // end up transformed into 'strictfp' LLVM attribute (TBD).1033 // Elsewhere, "precise/strict" FP mode should also set1034 // 'strictfp' for all user functions and calls so that1035 // LLVM backend does the right job.1036 // * Operations that cannot be reasonably optimized in MLIR1037 // can be also lowered to libm calls for "fast" and "relaxed"1038 // modes.1039 mlir::Value result;1040 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;1041 if (mathRuntimeVersion == preciseVersion &&1042 // Some operations do not have to be lowered as conservative1043 // calls, since they do not affect strict FP behavior.1044 // For example, purely integer operations like exponentiation1045 // with integer operands fall into this class.1046 !mathLibFuncName.empty()) {1047 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);1048 } else {1049 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName1050 << "' operation with type ";1051 mathLibFuncType.dump(); llvm::dbgs() << "\n");1052 result = T::create(builder, loc, args);1053 }1054 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");1055 return result;1056}1057 1058template <typename T>1059mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc,1060 const MathOperation &mathOp,1061 mlir::FunctionType mathLibFuncType,1062 llvm::ArrayRef<mlir::Value> args) {1063 mlir::Value result;1064 bool canUseApprox = mlir::arith::bitEnumContainsAny(1065 builder.getFastMathFlags(), mlir::arith::FastMathFlags::afn);1066 1067 // If we have libm functions, we can attempt to generate the more precise1068 // version of the complex math operation.1069 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;1070 if (!mathLibFuncName.empty()) {1071 // If we enabled MLIR complex or can use approximate operations, we should1072 // NOT use libm. Avoid libm when targeting AMDGPU as those symbols are not1073 // available on the device and we rely on MLIR complex operations to1074 // later map to OCML calls.1075 bool isAMDGPU = fir::getTargetTriple(builder.getModule()).isAMDGCN();1076 if (!forceMlirComplex && !canUseApprox && !isAMDGPU) {1077 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);1078 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");1079 return result;1080 }1081 }1082 1083 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName1084 << "' operation with type ";1085 mathLibFuncType.dump(); llvm::dbgs() << "\n");1086 // Builder expects an extra return type to be provided if different to1087 // the argument types for an operation1088 if constexpr (T::template hasTrait<1089 mlir::OpTrait::SameOperandsAndResultType>()) {1090 result = T::create(builder, loc, args);1091 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result);1092 } else {1093 auto complexTy = mlir::cast<mlir::ComplexType>(mathLibFuncType.getInput(0));1094 auto realTy = complexTy.getElementType();1095 result = T::create(builder, loc, realTy, args);1096 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result);1097 }1098 1099 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");1100 return result;1101}1102 1103/// Mapping between mathematical intrinsic operations and MLIR operations1104/// of some appropriate dialect (math, complex, etc.) or libm calls.1105/// TODO: support remaining Fortran math intrinsics.1106/// See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\1107/// Intrinsic-Procedures.html for a reference.1108constexpr auto FuncTypeReal16Real16 = genFuncType<Ty::Real<16>, Ty::Real<16>>;1109constexpr auto FuncTypeReal16Real16Real16 =1110 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;1111constexpr auto FuncTypeReal16Real16Real16Real16 =1112 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;1113constexpr auto FuncTypeReal16Integer4Real16 =1114 genFuncType<Ty::Real<16>, Ty::Integer<4>, Ty::Real<16>>;1115constexpr auto FuncTypeInteger4Real16 =1116 genFuncType<Ty::Integer<4>, Ty::Real<16>>;1117constexpr auto FuncTypeInteger8Real16 =1118 genFuncType<Ty::Integer<8>, Ty::Real<16>>;1119constexpr auto FuncTypeReal16Complex16 =1120 genFuncType<Ty::Real<16>, Ty::Complex<16>>;1121constexpr auto FuncTypeComplex16Complex16 =1122 genFuncType<Ty::Complex<16>, Ty::Complex<16>>;1123constexpr auto FuncTypeComplex16Complex16Complex16 =1124 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>;1125constexpr auto FuncTypeComplex16Complex16Integer4 =1126 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<4>>;1127constexpr auto FuncTypeComplex16Complex16Integer8 =1128 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<8>>;1129 1130static constexpr MathOperation mathOperations[] = {1131 {"abs", "fabsf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1132 genMathOp<mlir::math::AbsFOp>},1133 {"abs", "fabs", genFuncType<Ty::Real<8>, Ty::Real<8>>,1134 genMathOp<mlir::math::AbsFOp>},1135 {"abs", "llvm.fabs.f128", genFuncType<Ty::Real<16>, Ty::Real<16>>,1136 genMathOp<mlir::math::AbsFOp>},1137 {"abs", "cabsf", genFuncType<Ty::Real<4>, Ty::Complex<4>>,1138 genComplexMathOp<mlir::complex::AbsOp>},1139 {"abs", "cabs", genFuncType<Ty::Real<8>, Ty::Complex<8>>,1140 genComplexMathOp<mlir::complex::AbsOp>},1141 {"abs", RTNAME_STRING(CAbsF128), FuncTypeReal16Complex16, genLibF128Call},1142 {"acos", "acosf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1143 genMathOp<mlir::math::AcosOp>},1144 {"acos", "acos", genFuncType<Ty::Real<8>, Ty::Real<8>>,1145 genMathOp<mlir::math::AcosOp>},1146 {"acos", RTNAME_STRING(AcosF128), FuncTypeReal16Real16, genLibF128Call},1147 {"acos", "cacosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},1148 {"acos", "cacos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},1149 {"acos", RTNAME_STRING(CAcosF128), FuncTypeComplex16Complex16,1150 genLibF128Call},1151 {"acosh", "acoshf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1152 genMathOp<mlir::math::AcoshOp>},1153 {"acosh", "acosh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1154 genMathOp<mlir::math::AcoshOp>},1155 {"acosh", RTNAME_STRING(AcoshF128), FuncTypeReal16Real16, genLibF128Call},1156 {"acosh", "cacoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1157 genLibCall},1158 {"acosh", "cacosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1159 genLibCall},1160 {"acosh", RTNAME_STRING(CAcoshF128), FuncTypeComplex16Complex16,1161 genLibF128Call},1162 // llvm.trunc behaves the same way as libm's trunc.1163 {"aint", "llvm.trunc.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,1164 genLibCall},1165 {"aint", "llvm.trunc.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,1166 genLibCall},1167 {"aint", "llvm.trunc.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,1168 genLibCall},1169 {"aint", RTNAME_STRING(TruncF128), FuncTypeReal16Real16, genLibF128Call},1170 // llvm.round behaves the same way as libm's round.1171 {"anint", "llvm.round.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,1172 genMathOp<mlir::LLVM::RoundOp>},1173 {"anint", "llvm.round.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,1174 genMathOp<mlir::LLVM::RoundOp>},1175 {"anint", "llvm.round.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,1176 genMathOp<mlir::LLVM::RoundOp>},1177 {"anint", RTNAME_STRING(RoundF128), FuncTypeReal16Real16, genLibF128Call},1178 {"asin", "asinf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1179 genMathOp<mlir::math::AsinOp>},1180 {"asin", "asin", genFuncType<Ty::Real<8>, Ty::Real<8>>,1181 genMathOp<mlir::math::AsinOp>},1182 {"asin", RTNAME_STRING(AsinF128), FuncTypeReal16Real16, genLibF128Call},1183 {"asin", "casinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},1184 {"asin", "casin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},1185 {"asin", RTNAME_STRING(CAsinF128), FuncTypeComplex16Complex16,1186 genLibF128Call},1187 {"asinh", "asinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1188 genMathOp<mlir::math::AsinhOp>},1189 {"asinh", "asinh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1190 genMathOp<mlir::math::AsinhOp>},1191 {"asinh", RTNAME_STRING(AsinhF128), FuncTypeReal16Real16, genLibF128Call},1192 {"asinh", "casinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1193 genLibCall},1194 {"asinh", "casinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1195 genLibCall},1196 {"asinh", RTNAME_STRING(CAsinhF128), FuncTypeComplex16Complex16,1197 genLibF128Call},1198 {"atan", "atanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1199 genMathOp<mlir::math::AtanOp>},1200 {"atan", "atan", genFuncType<Ty::Real<8>, Ty::Real<8>>,1201 genMathOp<mlir::math::AtanOp>},1202 {"atan", RTNAME_STRING(AtanF128), FuncTypeReal16Real16, genLibF128Call},1203 {"atan", "catanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},1204 {"atan", "catan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},1205 {"atan", RTNAME_STRING(CAtanF128), FuncTypeComplex16Complex16,1206 genLibF128Call},1207 {"atan", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1208 genMathOp<mlir::math::Atan2Op>},1209 {"atan", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1210 genMathOp<mlir::math::Atan2Op>},1211 {"atan", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16,1212 genLibF128Call},1213 {"atan2", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1214 genMathOp<mlir::math::Atan2Op>},1215 {"atan2", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1216 genMathOp<mlir::math::Atan2Op>},1217 {"atan2", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16,1218 genLibF128Call},1219 {"atanh", "atanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1220 genMathOp<mlir::math::AtanhOp>},1221 {"atanh", "atanh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1222 genMathOp<mlir::math::AtanhOp>},1223 {"atanh", RTNAME_STRING(AtanhF128), FuncTypeReal16Real16, genLibF128Call},1224 {"atanh", "catanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1225 genLibCall},1226 {"atanh", "catanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1227 genLibCall},1228 {"atanh", RTNAME_STRING(CAtanhF128), FuncTypeComplex16Complex16,1229 genLibF128Call},1230 {"bessel_j0", "j0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1231 {"bessel_j0", "j0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1232 {"bessel_j0", RTNAME_STRING(J0F128), FuncTypeReal16Real16, genLibF128Call},1233 {"bessel_j1", "j1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1234 {"bessel_j1", "j1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1235 {"bessel_j1", RTNAME_STRING(J1F128), FuncTypeReal16Real16, genLibF128Call},1236 {"bessel_jn", "jnf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,1237 genLibCall},1238 {"bessel_jn", "jn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,1239 genLibCall},1240 {"bessel_jn", RTNAME_STRING(JnF128), FuncTypeReal16Integer4Real16,1241 genLibF128Call},1242 {"bessel_y0", "y0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1243 {"bessel_y0", "y0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1244 {"bessel_y0", RTNAME_STRING(Y0F128), FuncTypeReal16Real16, genLibF128Call},1245 {"bessel_y1", "y1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1246 {"bessel_y1", "y1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1247 {"bessel_y1", RTNAME_STRING(Y1F128), FuncTypeReal16Real16, genLibF128Call},1248 {"bessel_yn", "ynf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,1249 genLibCall},1250 {"bessel_yn", "yn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,1251 genLibCall},1252 {"bessel_yn", RTNAME_STRING(YnF128), FuncTypeReal16Integer4Real16,1253 genLibF128Call},1254 // math::CeilOp returns a real, while Fortran CEILING returns integer.1255 {"ceil", "ceilf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1256 genMathOp<mlir::math::CeilOp>},1257 {"ceil", "ceil", genFuncType<Ty::Real<8>, Ty::Real<8>>,1258 genMathOp<mlir::math::CeilOp>},1259 {"ceil", RTNAME_STRING(CeilF128), FuncTypeReal16Real16, genLibF128Call},1260 {"cos", "cosf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1261 genMathOp<mlir::math::CosOp>},1262 {"cos", "cos", genFuncType<Ty::Real<8>, Ty::Real<8>>,1263 genMathOp<mlir::math::CosOp>},1264 {"cos", RTNAME_STRING(CosF128), FuncTypeReal16Real16, genLibF128Call},1265 {"cos", "ccosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1266 genComplexMathOp<mlir::complex::CosOp>},1267 {"cos", "ccos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1268 genComplexMathOp<mlir::complex::CosOp>},1269 {"cos", RTNAME_STRING(CCosF128), FuncTypeComplex16Complex16,1270 genLibF128Call},1271 {"cosh", "coshf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1272 genMathOp<mlir::math::CoshOp>},1273 {"cosh", "cosh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1274 genMathOp<mlir::math::CoshOp>},1275 {"cosh", RTNAME_STRING(CoshF128), FuncTypeReal16Real16, genLibF128Call},1276 {"cosh", "ccoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},1277 {"cosh", "ccosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},1278 {"cosh", RTNAME_STRING(CCoshF128), FuncTypeComplex16Complex16,1279 genLibF128Call},1280 {"divc",1281 {},1282 genFuncType<Ty::Complex<2>, Ty::Complex<2>, Ty::Complex<2>>,1283 genComplexMathOp<mlir::complex::DivOp>},1284 {"divc",1285 {},1286 genFuncType<Ty::Complex<3>, Ty::Complex<3>, Ty::Complex<3>>,1287 genComplexMathOp<mlir::complex::DivOp>},1288 {"divc", "__divsc3",1289 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,1290 genLibSplitComplexArgsCall},1291 {"divc", "__divdc3",1292 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,1293 genLibSplitComplexArgsCall},1294 {"divc", "__divxc3",1295 genFuncType<Ty::Complex<10>, Ty::Complex<10>, Ty::Complex<10>>,1296 genLibSplitComplexArgsCall},1297 {"divc", "__divtc3",1298 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>,1299 genLibSplitComplexArgsCall},1300 {"erf", "erff", genFuncType<Ty::Real<4>, Ty::Real<4>>,1301 genMathOp<mlir::math::ErfOp>},1302 {"erf", "erf", genFuncType<Ty::Real<8>, Ty::Real<8>>,1303 genMathOp<mlir::math::ErfOp>},1304 {"erf", RTNAME_STRING(ErfF128), FuncTypeReal16Real16, genLibF128Call},1305 {"erfc", "erfcf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1306 genMathOp<mlir::math::ErfcOp>},1307 {"erfc", "erfc", genFuncType<Ty::Real<8>, Ty::Real<8>>,1308 genMathOp<mlir::math::ErfcOp>},1309 {"erfc", RTNAME_STRING(ErfcF128), FuncTypeReal16Real16, genLibF128Call},1310 {"exp", "expf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1311 genMathOp<mlir::math::ExpOp>},1312 {"exp", "exp", genFuncType<Ty::Real<8>, Ty::Real<8>>,1313 genMathOp<mlir::math::ExpOp>},1314 {"exp", RTNAME_STRING(ExpF128), FuncTypeReal16Real16, genLibF128Call},1315 {"exp", "cexpf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1316 genComplexMathOp<mlir::complex::ExpOp>},1317 {"exp", "cexp", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1318 genComplexMathOp<mlir::complex::ExpOp>},1319 {"exp", RTNAME_STRING(CExpF128), FuncTypeComplex16Complex16,1320 genLibF128Call},1321 {"feclearexcept", "feclearexcept",1322 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1323 {"fedisableexcept", "fedisableexcept",1324 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1325 {"feenableexcept", "feenableexcept",1326 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1327 {"fegetenv", "fegetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,1328 genLibCall},1329 {"fegetexcept", "fegetexcept", genFuncType<Ty::Integer<4>>, genLibCall},1330 {"fegetmode", "fegetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,1331 genLibCall},1332 {"feraiseexcept", "feraiseexcept",1333 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1334 {"fesetenv", "fesetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,1335 genLibCall},1336 {"fesetmode", "fesetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,1337 genLibCall},1338 {"fetestexcept", "fetestexcept",1339 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1340 {"feupdateenv", "feupdateenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,1341 genLibCall},1342 // math::FloorOp returns a real, while Fortran FLOOR returns integer.1343 {"floor", "floorf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1344 genMathOp<mlir::math::FloorOp>},1345 {"floor", "floor", genFuncType<Ty::Real<8>, Ty::Real<8>>,1346 genMathOp<mlir::math::FloorOp>},1347 {"floor", RTNAME_STRING(FloorF128), FuncTypeReal16Real16, genLibF128Call},1348 {"fma", "llvm.fma.f32",1349 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1350 genMathOp<mlir::math::FmaOp>},1351 {"fma", "llvm.fma.f64",1352 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1353 genMathOp<mlir::math::FmaOp>},1354 {"fma", RTNAME_STRING(FmaF128), FuncTypeReal16Real16Real16Real16,1355 genLibF128Call},1356 {"gamma", "tgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1357 {"gamma", "tgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1358 {"gamma", RTNAME_STRING(TgammaF128), FuncTypeReal16Real16, genLibF128Call},1359 {"hypot", "hypotf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1360 genLibCall},1361 {"hypot", "hypot", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1362 genLibCall},1363 {"hypot", RTNAME_STRING(HypotF128), FuncTypeReal16Real16Real16,1364 genLibF128Call},1365 {"log", "logf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1366 genMathOp<mlir::math::LogOp>},1367 {"log", "log", genFuncType<Ty::Real<8>, Ty::Real<8>>,1368 genMathOp<mlir::math::LogOp>},1369 {"log", RTNAME_STRING(LogF128), FuncTypeReal16Real16, genLibF128Call},1370 {"log", "clogf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1371 genComplexMathOp<mlir::complex::LogOp>},1372 {"log", "clog", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1373 genComplexMathOp<mlir::complex::LogOp>},1374 {"log", RTNAME_STRING(CLogF128), FuncTypeComplex16Complex16,1375 genLibF128Call},1376 {"log10", "log10f", genFuncType<Ty::Real<4>, Ty::Real<4>>,1377 genMathOp<mlir::math::Log10Op>},1378 {"log10", "log10", genFuncType<Ty::Real<8>, Ty::Real<8>>,1379 genMathOp<mlir::math::Log10Op>},1380 {"log10", RTNAME_STRING(Log10F128), FuncTypeReal16Real16, genLibF128Call},1381 {"log_gamma", "lgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},1382 {"log_gamma", "lgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},1383 {"log_gamma", RTNAME_STRING(LgammaF128), FuncTypeReal16Real16,1384 genLibF128Call},1385 {"nearbyint", "llvm.nearbyint.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,1386 genLibCall},1387 {"nearbyint", "llvm.nearbyint.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,1388 genLibCall},1389 {"nearbyint", "llvm.nearbyint.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,1390 genLibCall},1391 {"nearbyint", RTNAME_STRING(NearbyintF128), FuncTypeReal16Real16,1392 genLibF128Call},1393 // llvm.lround behaves the same way as libm's lround.1394 {"nint", "llvm.lround.i64.f64", genFuncType<Ty::Integer<8>, Ty::Real<8>>,1395 genLibCall},1396 {"nint", "llvm.lround.i64.f32", genFuncType<Ty::Integer<8>, Ty::Real<4>>,1397 genLibCall},1398 {"nint", RTNAME_STRING(LlroundF128), FuncTypeInteger8Real16,1399 genLibF128Call},1400 {"nint", "llvm.lround.i32.f64", genFuncType<Ty::Integer<4>, Ty::Real<8>>,1401 genLibCall},1402 {"nint", "llvm.lround.i32.f32", genFuncType<Ty::Integer<4>, Ty::Real<4>>,1403 genLibCall},1404 {"nint", RTNAME_STRING(LroundF128), FuncTypeInteger4Real16, genLibF128Call},1405 {"pow",1406 {},1407 genFuncType<Ty::Integer<1>, Ty::Integer<1>, Ty::Integer<1>>,1408 genMathOp<mlir::math::IPowIOp>},1409 {"pow",1410 {},1411 genFuncType<Ty::Integer<2>, Ty::Integer<2>, Ty::Integer<2>>,1412 genMathOp<mlir::math::IPowIOp>},1413 {"pow",1414 {},1415 genFuncType<Ty::Integer<4>, Ty::Integer<4>, Ty::Integer<4>>,1416 genMathOp<mlir::math::IPowIOp>},1417 {"pow",1418 {},1419 genFuncType<Ty::Integer<8>, Ty::Integer<8>, Ty::Integer<8>>,1420 genMathOp<mlir::math::IPowIOp>},1421 {"pow", "powf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1422 genMathOp<mlir::math::PowFOp>},1423 {"pow", "pow", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1424 genMathOp<mlir::math::PowFOp>},1425 {"pow", RTNAME_STRING(PowF128), FuncTypeReal16Real16Real16, genLibF128Call},1426 {"pow", "cpowf",1427 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,1428 genMathOp<mlir::complex::PowOp>},1429 {"pow", "cpow", genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,1430 genMathOp<mlir::complex::PowOp>},1431 {"pow", RTNAME_STRING(CPowF128), FuncTypeComplex16Complex16Complex16,1432 genMathOp<mlir::complex::PowOp>},1433 {"pow", RTNAME_STRING(FPow4i),1434 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<4>>,1435 genMathOp<mlir::math::FPowIOp>},1436 {"pow", RTNAME_STRING(FPow8i),1437 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<4>>,1438 genMathOp<mlir::math::FPowIOp>},1439 {"pow", RTNAME_STRING(FPow16i),1440 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<4>>,1441 genMathOp<mlir::math::FPowIOp>},1442 {"pow", RTNAME_STRING(FPow4k),1443 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<8>>,1444 genMathOp<mlir::math::FPowIOp>},1445 {"pow", RTNAME_STRING(FPow8k),1446 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<8>>,1447 genMathOp<mlir::math::FPowIOp>},1448 {"pow", RTNAME_STRING(FPow16k),1449 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<8>>,1450 genMathOp<mlir::math::FPowIOp>},1451 {"pow", RTNAME_STRING(cpowi),1452 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<4>>,1453 genMathOp<mlir::complex::PowiOp>},1454 {"pow", RTNAME_STRING(zpowi),1455 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<4>>,1456 genMathOp<mlir::complex::PowiOp>},1457 {"pow", RTNAME_STRING(cqpowi), FuncTypeComplex16Complex16Integer4,1458 genMathOp<mlir::complex::PowiOp>},1459 {"pow", RTNAME_STRING(cpowk),1460 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<8>>,1461 genMathOp<mlir::complex::PowiOp>},1462 {"pow", RTNAME_STRING(zpowk),1463 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<8>>,1464 genMathOp<mlir::complex::PowiOp>},1465 {"pow", RTNAME_STRING(cqpowk), FuncTypeComplex16Complex16Integer8,1466 genMathOp<mlir::complex::PowiOp>},1467 {"pow-unsigned", RTNAME_STRING(UPow1),1468 genFuncType<Ty::Integer<1>, Ty::Integer<1>, Ty::Integer<1>>, genLibCall},1469 {"pow-unsigned", RTNAME_STRING(UPow2),1470 genFuncType<Ty::Integer<2>, Ty::Integer<2>, Ty::Integer<2>>, genLibCall},1471 {"pow-unsigned", RTNAME_STRING(UPow4),1472 genFuncType<Ty::Integer<4>, Ty::Integer<4>, Ty::Integer<4>>, genLibCall},1473 {"pow-unsigned", RTNAME_STRING(UPow8),1474 genFuncType<Ty::Integer<8>, Ty::Integer<8>, Ty::Integer<8>>, genLibCall},1475 {"remainder", "remainderf",1476 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, genLibCall},1477 {"remainder", "remainder",1478 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, genLibCall},1479 {"remainder", "remainderl",1480 genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>, genLibCall},1481 {"remainder", RTNAME_STRING(RemainderF128), FuncTypeReal16Real16Real16,1482 genLibF128Call},1483 {"sign", "copysignf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,1484 genMathOp<mlir::math::CopySignOp>},1485 {"sign", "copysign", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,1486 genMathOp<mlir::math::CopySignOp>},1487 {"sign", "copysignl", genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>,1488 genMathOp<mlir::math::CopySignOp>},1489 {"sign", "llvm.copysign.f128",1490 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>,1491 genMathOp<mlir::math::CopySignOp>},1492 {"sin", "sinf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1493 genMathOp<mlir::math::SinOp>},1494 {"sin", "sin", genFuncType<Ty::Real<8>, Ty::Real<8>>,1495 genMathOp<mlir::math::SinOp>},1496 {"sin", RTNAME_STRING(SinF128), FuncTypeReal16Real16, genLibF128Call},1497 {"sin", "csinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1498 genComplexMathOp<mlir::complex::SinOp>},1499 {"sin", "csin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1500 genComplexMathOp<mlir::complex::SinOp>},1501 {"sin", RTNAME_STRING(CSinF128), FuncTypeComplex16Complex16,1502 genLibF128Call},1503 {"sinh", "sinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1504 genMathOp<mlir::math::SinhOp>},1505 {"sinh", "sinh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1506 genMathOp<mlir::math::SinhOp>},1507 {"sinh", RTNAME_STRING(SinhF128), FuncTypeReal16Real16, genLibF128Call},1508 {"sinh", "csinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},1509 {"sinh", "csinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},1510 {"sinh", RTNAME_STRING(CSinhF128), FuncTypeComplex16Complex16,1511 genLibF128Call},1512 {"sqrt", "sqrtf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1513 genMathOp<mlir::math::SqrtOp>},1514 {"sqrt", "sqrt", genFuncType<Ty::Real<8>, Ty::Real<8>>,1515 genMathOp<mlir::math::SqrtOp>},1516 {"sqrt", RTNAME_STRING(SqrtF128), FuncTypeReal16Real16, genLibF128Call},1517 {"sqrt", "csqrtf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1518 genComplexMathOp<mlir::complex::SqrtOp>},1519 {"sqrt", "csqrt", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1520 genComplexMathOp<mlir::complex::SqrtOp>},1521 {"sqrt", RTNAME_STRING(CSqrtF128), FuncTypeComplex16Complex16,1522 genLibF128Call},1523 {"tan", "tanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1524 genMathOp<mlir::math::TanOp>},1525 {"tan", "tan", genFuncType<Ty::Real<8>, Ty::Real<8>>,1526 genMathOp<mlir::math::TanOp>},1527 {"tan", RTNAME_STRING(TanF128), FuncTypeReal16Real16, genLibF128Call},1528 {"tan", "ctanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1529 genComplexMathOp<mlir::complex::TanOp>},1530 {"tan", "ctan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1531 genComplexMathOp<mlir::complex::TanOp>},1532 {"tan", RTNAME_STRING(CTanF128), FuncTypeComplex16Complex16,1533 genLibF128Call},1534 {"tanh", "tanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,1535 genMathOp<mlir::math::TanhOp>},1536 {"tanh", "tanh", genFuncType<Ty::Real<8>, Ty::Real<8>>,1537 genMathOp<mlir::math::TanhOp>},1538 {"tanh", RTNAME_STRING(TanhF128), FuncTypeReal16Real16, genLibF128Call},1539 {"tanh", "ctanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,1540 genComplexMathOp<mlir::complex::TanhOp>},1541 {"tanh", "ctanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,1542 genComplexMathOp<mlir::complex::TanhOp>},1543 {"tanh", RTNAME_STRING(CTanhF128), FuncTypeComplex16Complex16,1544 genLibF128Call},1545};1546 1547// This helper class computes a "distance" between two function types.1548// The distance measures how many narrowing conversions of actual arguments1549// and result of "from" must be made in order to use "to" instead of "from".1550// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is1551// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means1552// if no implementation of ACOS(REAL(10)) is available, it is better to use1553// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).1554// Note that this is not a symmetric distance and the order of "from" and "to"1555// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it1556// may be safe to replace foo by bar, but not the opposite.1557class FunctionDistance {1558public:1559 FunctionDistance() : infinite{true} {}1560 1561 FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {1562 unsigned nInputs = from.getNumInputs();1563 unsigned nResults = from.getNumResults();1564 if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {1565 infinite = true;1566 } else {1567 for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)1568 addArgumentDistance(from.getInput(i), to.getInput(i));1569 for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)1570 addResultDistance(to.getResult(i), from.getResult(i));1571 }1572 }1573 1574 /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be1575 /// false if both d1 and d2 are infinite. This implies that1576 /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)1577 bool isSmallerThan(const FunctionDistance &d) const {1578 return !infinite &&1579 (d.infinite || std::lexicographical_compare(1580 conversions.begin(), conversions.end(),1581 d.conversions.begin(), d.conversions.end()));1582 }1583 1584 bool isLosingPrecision() const {1585 return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;1586 }1587 1588 bool isInfinite() const { return infinite; }1589 1590private:1591 enum class Conversion { Forbidden, None, Narrow, Extend };1592 1593 void addArgumentDistance(mlir::Type from, mlir::Type to) {1594 switch (conversionBetweenTypes(from, to)) {1595 case Conversion::Forbidden:1596 infinite = true;1597 break;1598 case Conversion::None:1599 break;1600 case Conversion::Narrow:1601 conversions[narrowingArg]++;1602 break;1603 case Conversion::Extend:1604 conversions[nonNarrowingArg]++;1605 break;1606 }1607 }1608 1609 void addResultDistance(mlir::Type from, mlir::Type to) {1610 switch (conversionBetweenTypes(from, to)) {1611 case Conversion::Forbidden:1612 infinite = true;1613 break;1614 case Conversion::None:1615 break;1616 case Conversion::Narrow:1617 conversions[nonExtendingResult]++;1618 break;1619 case Conversion::Extend:1620 conversions[extendingResult]++;1621 break;1622 }1623 }1624 1625 // Floating point can be mlir Float or Complex Type.1626 static unsigned getFloatingPointWidth(mlir::Type t) {1627 if (auto f{mlir::dyn_cast<mlir::FloatType>(t)})1628 return f.getWidth();1629 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(t)})1630 return mlir::cast<mlir::FloatType>(cplx.getElementType()).getWidth();1631 llvm_unreachable("not a floating-point type");1632 }1633 1634 static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {1635 if (from == to)1636 return Conversion::None;1637 1638 if (auto fromIntTy{mlir::dyn_cast<mlir::IntegerType>(from)}) {1639 if (auto toIntTy{mlir::dyn_cast<mlir::IntegerType>(to)}) {1640 return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow1641 : Conversion::Extend;1642 }1643 }1644 1645 if (fir::isa_real(from) && fir::isa_real(to)) {1646 return getFloatingPointWidth(from) > getFloatingPointWidth(to)1647 ? Conversion::Narrow1648 : Conversion::Extend;1649 }1650 1651 if (fir::isa_complex(from) && fir::isa_complex(to)) {1652 return getFloatingPointWidth(from) > getFloatingPointWidth(to)1653 ? Conversion::Narrow1654 : Conversion::Extend;1655 }1656 // Notes:1657 // - No conversion between character types, specialization of runtime1658 // functions should be made instead.1659 // - It is not clear there is a use case for automatic conversions1660 // around Logical and it may damage hidden information in the physical1661 // storage so do not do it.1662 return Conversion::Forbidden;1663 }1664 1665 // Below are indexes to access data in conversions.1666 // The order in data does matter for lexicographical_compare1667 enum {1668 narrowingArg = 0, // usually bad1669 extendingResult, // usually bad1670 nonExtendingResult, // usually ok1671 nonNarrowingArg, // usually ok1672 dataSize1673 };1674 1675 std::array<int, dataSize> conversions = {};1676 bool infinite = false; // When forbidden conversion or wrong argument number1677};1678 1679using RtMap = Fortran::common::StaticMultimapView<MathOperation>;1680static constexpr RtMap mathOps(mathOperations);1681static_assert(mathOps.Verify() && "map must be sorted");1682 1683/// Look for a MathOperation entry specifying how to lower a mathematical1684/// operation defined by \p name with its result' and operands' types1685/// specified in the form of a FunctionType \p funcType.1686/// If exact match for the given types is found, then the function1687/// returns a pointer to the corresponding MathOperation.1688/// Otherwise, the function returns nullptr.1689/// If there is a MathOperation that can be used with additional1690/// type casts for the operands or/and result (non-exact match),1691/// then it is returned via \p bestNearMatch argument, and1692/// \p bestMatchDistance specifies the FunctionDistance between1693/// the requested operation and the non-exact match.1694static const MathOperation *1695searchMathOperation(fir::FirOpBuilder &builder,1696 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,1697 mlir::FunctionType funcType,1698 const MathOperation **bestNearMatch,1699 FunctionDistance &bestMatchDistance) {1700 for (auto iter = range.first; iter != range.second && iter; ++iter) {1701 const auto &impl = *iter;1702 auto implType = impl.typeGenerator(builder.getContext(), builder);1703 if (funcType == implType) {1704 return &impl; // exact match1705 }1706 1707 FunctionDistance distance(funcType, implType);1708 if (distance.isSmallerThan(bestMatchDistance)) {1709 *bestNearMatch = &impl;1710 bestMatchDistance = std::move(distance);1711 }1712 }1713 return nullptr;1714}1715 1716/// Implementation of the operation defined by \p name with type1717/// \p funcType is not precise, and the actual available implementation1718/// is \p distance away from the requested. If using the available1719/// implementation results in a precision loss, emit an error message1720/// with the given code location \p loc.1721static void checkPrecisionLoss(llvm::StringRef name,1722 mlir::FunctionType funcType,1723 const FunctionDistance &distance,1724 fir::FirOpBuilder &builder, mlir::Location loc) {1725 if (!distance.isLosingPrecision())1726 return;1727 1728 // Using this runtime version requires narrowing the arguments1729 // or extending the result. It is not numerically safe. There1730 // is currently no quad math library that was described in1731 // lowering and could be used here. Emit an error and continue1732 // generating the code with the narrowing cast so that the user1733 // can get a complete list of the problematic intrinsic calls.1734 std::string message = prettyPrintIntrinsicName(1735 builder, loc, "not yet implemented: no math runtime available for '",1736 name, "'", funcType);1737 mlir::emitError(loc, message);1738}1739 1740/// Helpers to get function type from arguments and result type.1741static mlir::FunctionType getFunctionType(std::optional<mlir::Type> resultType,1742 llvm::ArrayRef<mlir::Value> arguments,1743 fir::FirOpBuilder &builder) {1744 llvm::SmallVector<mlir::Type> argTypes;1745 for (mlir::Value arg : arguments)1746 argTypes.push_back(arg.getType());1747 llvm::SmallVector<mlir::Type> resTypes;1748 if (resultType)1749 resTypes.push_back(*resultType);1750 return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,1751 resTypes);1752}1753 1754/// fir::ExtendedValue to mlir::Value translation layer1755 1756fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,1757 mlir::Location loc) {1758 assert(val && "optional unhandled here");1759 mlir::Type type = val.getType();1760 mlir::Value base = val;1761 mlir::IndexType indexType = builder.getIndexType();1762 llvm::SmallVector<mlir::Value> extents;1763 1764 fir::factory::CharacterExprHelper charHelper{builder, loc};1765 // FIXME: we may want to allow non character scalar here.1766 if (charHelper.isCharacterScalar(type))1767 return charHelper.toExtendedValue(val);1768 1769 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type))1770 type = refType.getEleTy();1771 1772 if (auto arrayType = mlir::dyn_cast<fir::SequenceType>(type)) {1773 type = arrayType.getEleTy();1774 for (fir::SequenceType::Extent extent : arrayType.getShape()) {1775 if (extent == fir::SequenceType::getUnknownExtent())1776 break;1777 extents.emplace_back(1778 builder.createIntegerConstant(loc, indexType, extent));1779 }1780 // Last extent might be missing in case of assumed-size. If more extents1781 // could not be deduced from type, that's an error (a fir.box should1782 // have been used in the interface).1783 if (extents.size() + 1 < arrayType.getShape().size())1784 mlir::emitError(loc, "cannot retrieve array extents from type");1785 } else if (mlir::isa<fir::BoxType>(type) ||1786 mlir::isa<fir::RecordType>(type)) {1787 fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");1788 }1789 1790 if (!extents.empty())1791 return fir::ArrayBoxValue{base, extents};1792 return base;1793}1794 1795mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,1796 mlir::Location loc) {1797 if (const fir::CharBoxValue *charBox = val.getCharBox()) {1798 mlir::Value buffer = charBox->getBuffer();1799 auto buffTy = buffer.getType();1800 if (mlir::isa<mlir::FunctionType>(buffTy))1801 fir::emitFatalError(1802 loc, "A character's buffer type cannot be a function type.");1803 if (mlir::isa<fir::BoxCharType>(buffTy))1804 return buffer;1805 return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(1806 buffer, charBox->getLen());1807 }1808 1809 // FIXME: need to access other ExtendedValue variants and handle them1810 // properly.1811 return fir::getBase(val);1812}1813 1814//===----------------------------------------------------------------------===//1815// IntrinsicLibrary1816//===----------------------------------------------------------------------===//1817 1818static bool isIntrinsicModuleProcedure(llvm::StringRef name) {1819 return name.starts_with("c_") || name.starts_with("compiler_") ||1820 name.starts_with("ieee_") || name.starts_with("__ppc_");1821}1822 1823static bool isCoarrayIntrinsic(llvm::StringRef name) {1824 return name.starts_with("atomic_") || name.starts_with("co_") ||1825 name.contains("image") || name.ends_with("cobound") ||1826 name == "team_number";1827}1828 1829/// Return the generic name of an intrinsic module procedure specific name.1830/// Remove any "__builtin_" prefix, and any specific suffix of the form1831/// {_[ail]?[0-9]+}*, such as _1 or _a4.1832llvm::StringRef genericName(llvm::StringRef specificName) {1833 const std::string builtin = "__builtin_";1834 llvm::StringRef name = specificName.starts_with(builtin)1835 ? specificName.drop_front(builtin.size())1836 : specificName;1837 size_t size = name.size();1838 if (isIntrinsicModuleProcedure(name))1839 while (isdigit(name[size - 1]))1840 while (name[--size] != '_')1841 ;1842 return name.drop_back(name.size() - size);1843}1844 1845std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>1846lookupRuntimeGenerator(llvm::StringRef name, bool isPPCTarget) {1847 if (auto range = mathOps.equal_range(name); range.first != range.second)1848 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(1849 range);1850 // Search ppcMathOps only if targetting PowerPC arch1851 if (isPPCTarget)1852 if (auto range = checkPPCMathOperationsRange(name);1853 range.first != range.second)1854 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(1855 range);1856 return std::nullopt;1857}1858 1859std::optional<IntrinsicHandlerEntry>1860lookupIntrinsicHandler(fir::FirOpBuilder &builder,1861 llvm::StringRef intrinsicName,1862 std::optional<mlir::Type> resultType) {1863 llvm::StringRef name = genericName(intrinsicName);1864 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))1865 return std::make_optional<IntrinsicHandlerEntry>(handler);1866 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();1867 // If targeting PowerPC, check PPC intrinsic handlers.1868 if (isPPCTarget)1869 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))1870 return std::make_optional<IntrinsicHandlerEntry>(ppcHandler);1871 // TODO: Look for CUDA intrinsic handlers only if CUDA is enabled.1872 if (const IntrinsicHandler *cudaHandler = findCUDAIntrinsicHandler(name))1873 return std::make_optional<IntrinsicHandlerEntry>(cudaHandler);1874 // Subroutines should have a handler.1875 if (!resultType)1876 return std::nullopt;1877 // Try the runtime if no special handler was defined for the1878 // intrinsic being called. Maths runtime only has numerical elemental.1879 if (auto runtimeGeneratorRange = lookupRuntimeGenerator(name, isPPCTarget))1880 return std::make_optional<IntrinsicHandlerEntry>(*runtimeGeneratorRange);1881 return std::nullopt;1882}1883 1884/// Generate a TODO error message for an as yet unimplemented intrinsic.1885void crashOnMissingIntrinsic(mlir::Location loc,1886 llvm::StringRef intrinsicName) {1887 llvm::StringRef name = genericName(intrinsicName);1888 if (isIntrinsicModuleProcedure(name))1889 TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));1890 else if (isCoarrayIntrinsic(name))1891 TODO(loc, "coarray: intrinsic " + llvm::Twine(name));1892 else1893 TODO(loc, "intrinsic: " + llvm::Twine(name.upper()));1894}1895 1896template <typename GeneratorType>1897fir::ExtendedValue IntrinsicLibrary::genElementalCall(1898 GeneratorType generator, llvm::StringRef name, mlir::Type resultType,1899 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {1900 llvm::SmallVector<mlir::Value> scalarArgs;1901 for (const fir::ExtendedValue &arg : args)1902 if (arg.getUnboxed() || arg.getCharBox())1903 scalarArgs.emplace_back(fir::getBase(arg));1904 else1905 fir::emitFatalError(loc, "nonscalar intrinsic argument");1906 if (outline)1907 return outlineInWrapper(generator, name, resultType, scalarArgs);1908 return invokeGenerator(generator, resultType, scalarArgs);1909}1910 1911template <>1912fir::ExtendedValue1913IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(1914 ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,1915 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {1916 for (const fir::ExtendedValue &arg : args) {1917 auto *box = arg.getBoxOf<fir::BoxValue>();1918 if (!arg.getUnboxed() && !arg.getCharBox() &&1919 !(box && (fir::isScalarBoxedRecordType(fir::getBase(*box).getType()) ||1920 fir::isClassStarType(fir::getBase(*box).getType()))))1921 fir::emitFatalError(loc, "nonscalar intrinsic argument");1922 }1923 if (outline)1924 return outlineInExtendedWrapper(generator, name, resultType, args);1925 return std::invoke(generator, *this, resultType, args);1926}1927 1928template <>1929fir::ExtendedValue1930IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(1931 SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,1932 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {1933 for (const fir::ExtendedValue &arg : args)1934 if (!arg.getUnboxed() && !arg.getCharBox())1935 // fir::emitFatalError(loc, "nonscalar intrinsic argument");1936 crashOnMissingIntrinsic(loc, name);1937 if (outline)1938 return outlineInExtendedWrapper(generator, name, resultType, args);1939 std::invoke(generator, *this, args);1940 return mlir::Value();1941}1942 1943template <>1944fir::ExtendedValue1945IntrinsicLibrary::genElementalCall<IntrinsicLibrary::DualGenerator>(1946 DualGenerator generator, llvm::StringRef name, mlir::Type resultType,1947 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {1948 assert(resultType.getImpl() && "expect elemental intrinsic to be functions");1949 1950 for (const fir::ExtendedValue &arg : args)1951 if (!arg.getUnboxed() && !arg.getCharBox())1952 // fir::emitFatalError(loc, "nonscalar intrinsic argument");1953 crashOnMissingIntrinsic(loc, name);1954 if (outline)1955 return outlineInExtendedWrapper(generator, name, resultType, args);1956 1957 return std::invoke(generator, *this, std::optional<mlir::Type>{resultType},1958 args);1959}1960 1961static fir::ExtendedValue1962invokeHandler(IntrinsicLibrary::ElementalGenerator generator,1963 const IntrinsicHandler &handler,1964 std::optional<mlir::Type> resultType,1965 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,1966 IntrinsicLibrary &lib) {1967 assert(resultType && "expect elemental intrinsic to be functions");1968 return lib.genElementalCall(generator, handler.name, *resultType, args,1969 outline);1970}1971 1972static fir::ExtendedValue1973invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,1974 const IntrinsicHandler &handler,1975 std::optional<mlir::Type> resultType,1976 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,1977 IntrinsicLibrary &lib) {1978 assert(resultType && "expect intrinsic function");1979 if (handler.isElemental)1980 return lib.genElementalCall(generator, handler.name, *resultType, args,1981 outline);1982 if (outline)1983 return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,1984 args);1985 return std::invoke(generator, lib, *resultType, args);1986}1987 1988static fir::ExtendedValue1989invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,1990 const IntrinsicHandler &handler,1991 std::optional<mlir::Type> resultType,1992 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,1993 IntrinsicLibrary &lib) {1994 if (handler.isElemental)1995 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,1996 outline);1997 if (outline)1998 return lib.outlineInExtendedWrapper(generator, handler.name, resultType,1999 args);2000 std::invoke(generator, lib, args);2001 return mlir::Value{};2002}2003 2004static fir::ExtendedValue2005invokeHandler(IntrinsicLibrary::DualGenerator generator,2006 const IntrinsicHandler &handler,2007 std::optional<mlir::Type> resultType,2008 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,2009 IntrinsicLibrary &lib) {2010 if (handler.isElemental)2011 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,2012 outline);2013 if (outline)2014 return lib.outlineInExtendedWrapper(generator, handler.name, resultType,2015 args);2016 2017 return std::invoke(generator, lib, resultType, args);2018}2019 2020static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(2021 const IntrinsicHandler *handler, std::optional<mlir::Type> resultType,2022 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {2023 assert(handler && "must be set");2024 bool outline = handler->outline || outlineAllIntrinsics;2025 return {Fortran::common::visit(2026 [&](auto &generator) -> fir::ExtendedValue {2027 return invokeHandler(generator, *handler, resultType, args,2028 outline, lib);2029 },2030 handler->generator),2031 lib.resultMustBeFreed};2032}2033 2034static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(2035 const IntrinsicHandlerEntry::RuntimeGeneratorRange &, mlir::FunctionType,2036 fir::FirOpBuilder &, mlir::Location);2037 2038static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(2039 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,2040 std::optional<mlir::Type> resultType,2041 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {2042 assert(resultType.has_value() && "RuntimeGenerator are for functions only");2043 assert(range.first != nullptr && "range should not be empty");2044 fir::FirOpBuilder &builder = lib.builder;2045 mlir::Location loc = lib.loc;2046 llvm::StringRef name = range.first->key;2047 // FIXME: using toValue to get the type won't work with array arguments.2048 llvm::SmallVector<mlir::Value> mlirArgs;2049 for (const fir::ExtendedValue &extendedVal : args) {2050 mlir::Value val = toValue(extendedVal, builder, loc);2051 if (!val)2052 // If an absent optional gets there, most likely its handler has just2053 // not yet been defined.2054 crashOnMissingIntrinsic(loc, name);2055 mlirArgs.emplace_back(val);2056 }2057 mlir::FunctionType soughtFuncType =2058 getFunctionType(*resultType, mlirArgs, builder);2059 2060 IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =2061 getRuntimeCallGeneratorHelper(range, soughtFuncType, builder, loc);2062 return {lib.genElementalCall(runtimeCallGenerator, name, *resultType, args,2063 /*outline=*/outlineAllIntrinsics),2064 lib.resultMustBeFreed};2065}2066 2067std::pair<fir::ExtendedValue, bool>2068genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,2069 const IntrinsicHandlerEntry &intrinsic,2070 std::optional<mlir::Type> resultType,2071 llvm::ArrayRef<fir::ExtendedValue> args,2072 Fortran::lower::AbstractConverter *converter) {2073 IntrinsicLibrary library{builder, loc, converter};2074 return std::visit(2075 [&](auto handler) -> auto {2076 return genIntrinsicCallHelper(handler, resultType, args, library);2077 },2078 intrinsic.entry);2079}2080 2081std::pair<fir::ExtendedValue, bool>2082IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,2083 std::optional<mlir::Type> resultType,2084 llvm::ArrayRef<fir::ExtendedValue> args) {2085 std::optional<IntrinsicHandlerEntry> intrinsic =2086 lookupIntrinsicHandler(builder, specificName, resultType);2087 if (!intrinsic.has_value())2088 crashOnMissingIntrinsic(loc, specificName);2089 return std::visit(2090 [&](auto handler) -> auto {2091 return genIntrinsicCallHelper(handler, resultType, args, *this);2092 },2093 intrinsic->entry);2094}2095 2096mlir::Value2097IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,2098 mlir::Type resultType,2099 llvm::ArrayRef<mlir::Value> args) {2100 return std::invoke(generator, *this, resultType, args);2101}2102 2103mlir::Value2104IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,2105 mlir::Type resultType,2106 llvm::ArrayRef<mlir::Value> args) {2107 return generator(builder, loc, args);2108}2109 2110mlir::Value2111IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,2112 mlir::Type resultType,2113 llvm::ArrayRef<mlir::Value> args) {2114 llvm::SmallVector<fir::ExtendedValue> extendedArgs;2115 for (mlir::Value arg : args)2116 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));2117 auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);2118 return toValue(extendedResult, builder, loc);2119}2120 2121mlir::Value2122IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,2123 llvm::ArrayRef<mlir::Value> args) {2124 llvm::SmallVector<fir::ExtendedValue> extendedArgs;2125 for (mlir::Value arg : args)2126 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));2127 std::invoke(generator, *this, extendedArgs);2128 return {};2129}2130 2131mlir::Value2132IntrinsicLibrary::invokeGenerator(DualGenerator generator,2133 llvm::ArrayRef<mlir::Value> args) {2134 llvm::SmallVector<fir::ExtendedValue> extendedArgs;2135 for (mlir::Value arg : args)2136 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));2137 std::invoke(generator, *this, std::optional<mlir::Type>{}, extendedArgs);2138 return {};2139}2140 2141mlir::Value2142IntrinsicLibrary::invokeGenerator(DualGenerator generator,2143 mlir::Type resultType,2144 llvm::ArrayRef<mlir::Value> args) {2145 llvm::SmallVector<fir::ExtendedValue> extendedArgs;2146 for (mlir::Value arg : args)2147 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));2148 2149 if (resultType.getImpl() == nullptr) {2150 // TODO:2151 assert(false && "result type is null");2152 }2153 2154 auto extendedResult = std::invoke(2155 generator, *this, std::optional<mlir::Type>{resultType}, extendedArgs);2156 return toValue(extendedResult, builder, loc);2157}2158 2159//===----------------------------------------------------------------------===//2160// Intrinsic Procedure Mangling2161//===----------------------------------------------------------------------===//2162 2163/// Helper to encode type into string for intrinsic procedure names.2164/// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not2165/// suitable for function names.2166static std::string typeToString(mlir::Type t) {2167 if (auto refT{mlir::dyn_cast<fir::ReferenceType>(t)})2168 return "ref_" + typeToString(refT.getEleTy());2169 if (auto i{mlir::dyn_cast<mlir::IntegerType>(t)}) {2170 return "i" + std::to_string(i.getWidth());2171 }2172 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(t)}) {2173 auto eleTy = mlir::cast<mlir::FloatType>(cplx.getElementType());2174 return "z" + std::to_string(eleTy.getWidth());2175 }2176 if (auto f{mlir::dyn_cast<mlir::FloatType>(t)}) {2177 return "f" + std::to_string(f.getWidth());2178 }2179 if (auto logical{mlir::dyn_cast<fir::LogicalType>(t)}) {2180 return "l" + std::to_string(logical.getFKind());2181 }2182 if (auto character{mlir::dyn_cast<fir::CharacterType>(t)}) {2183 return "c" + std::to_string(character.getFKind());2184 }2185 if (auto boxCharacter{mlir::dyn_cast<fir::BoxCharType>(t)}) {2186 return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());2187 }2188 llvm_unreachable("no mangling for type");2189}2190 2191/// Returns a name suitable to define mlir functions for Fortran intrinsic2192/// Procedure. These names are guaranteed to not conflict with user defined2193/// procedures. This is needed to implement Fortran generic intrinsics as2194/// several mlir functions specialized for the argument types.2195/// The result is guaranteed to be distinct for different mlir::FunctionType2196/// arguments. The mangling pattern is:2197/// fir.<generic name>.<result type>.<arg type>...2198/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z42199/// For subroutines no result type is return but in order to still provide2200/// a unique mangled name, we use "void" as the return type. As in:2201/// fir.<generic name>.void.<arg type>...2202/// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i42203static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic,2204 mlir::FunctionType funTy) {2205 std::string name = "fir.";2206 name.append(intrinsic.str()).append(".");2207 if (funTy.getNumResults() == 1)2208 name.append(typeToString(funTy.getResult(0)));2209 else if (funTy.getNumResults() == 0)2210 name.append("void");2211 else2212 llvm_unreachable("more than one result value for function");2213 unsigned e = funTy.getNumInputs();2214 for (decltype(e) i = 0; i < e; ++i)2215 name.append(".").append(typeToString(funTy.getInput(i)));2216 return name;2217}2218 2219template <typename GeneratorType>2220mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,2221 llvm::StringRef name,2222 mlir::FunctionType funcType,2223 bool loadRefArguments) {2224 std::string wrapperName = mangleIntrinsicProcedure(name, funcType);2225 mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);2226 if (!function) {2227 // First time this wrapper is needed, build it.2228 function = builder.createFunction(loc, wrapperName, funcType);2229 function->setAttr("fir.intrinsic", builder.getUnitAttr());2230 fir::factory::setInternalLinkage(function);2231 function.addEntryBlock();2232 2233 // Create local context to emit code into the newly created function2234 // This new function is not linked to a source file location, only2235 // its calls will be.2236 auto localBuilder = std::make_unique<fir::FirOpBuilder>(2237 function, builder.getKindMap(), builder.getMLIRSymbolTable());2238 localBuilder->setFastMathFlags(builder.getFastMathFlags());2239 localBuilder->setInsertionPointToStart(&function.front());2240 // Location of code inside wrapper of the wrapper is independent from2241 // the location of the intrinsic call.2242 mlir::Location localLoc = localBuilder->getUnknownLoc();2243 llvm::SmallVector<mlir::Value> localArguments;2244 for (mlir::BlockArgument bArg : function.front().getArguments()) {2245 auto refType = mlir::dyn_cast<fir::ReferenceType>(bArg.getType());2246 if (loadRefArguments && refType) {2247 auto loaded = fir::LoadOp::create(*localBuilder, localLoc, bArg);2248 localArguments.push_back(loaded);2249 } else {2250 localArguments.push_back(bArg);2251 }2252 }2253 2254 IntrinsicLibrary localLib{*localBuilder, localLoc};2255 2256 if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {2257 localLib.invokeGenerator(generator, localArguments);2258 mlir::func::ReturnOp::create(*localBuilder, localLoc);2259 } else {2260 assert(funcType.getNumResults() == 1 &&2261 "expect one result for intrinsic function wrapper type");2262 mlir::Type resultType = funcType.getResult(0);2263 auto result =2264 localLib.invokeGenerator(generator, resultType, localArguments);2265 mlir::func::ReturnOp::create(*localBuilder, localLoc, result);2266 }2267 } else {2268 // Wrapper was already built, ensure it has the sought type2269 assert(function.getFunctionType() == funcType &&2270 "conflict between intrinsic wrapper types");2271 }2272 return function;2273}2274 2275/// Helpers to detect absent optional (not yet supported in outlining).2276bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {2277 for (const mlir::Value &arg : args)2278 if (!arg)2279 return true;2280 return false;2281}2282bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {2283 for (const fir::ExtendedValue &arg : args)2284 if (!fir::getBase(arg))2285 return true;2286 return false;2287}2288 2289template <typename GeneratorType>2290mlir::Value2291IntrinsicLibrary::outlineInWrapper(GeneratorType generator,2292 llvm::StringRef name, mlir::Type resultType,2293 llvm::ArrayRef<mlir::Value> args) {2294 if (hasAbsentOptional(args)) {2295 // TODO: absent optional in outlining is an issue: we cannot just ignore2296 // them. Needs a better interface here. The issue is that we cannot easily2297 // tell that a value is optional or not here if it is presents. And if it is2298 // absent, we cannot tell what it type should be.2299 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +2300 " with absent optional argument");2301 }2302 2303 mlir::FunctionType funcType = getFunctionType(resultType, args, builder);2304 std::string funcName{name};2305 llvm::raw_string_ostream nameOS{funcName};2306 if (std::string fmfString{builder.getFastMathFlagsString()};2307 !fmfString.empty()) {2308 nameOS << '.' << fmfString;2309 }2310 mlir::func::FuncOp wrapper = getWrapper(generator, funcName, funcType);2311 return fir::CallOp::create(builder, loc, wrapper, args).getResult(0);2312}2313 2314template <typename GeneratorType>2315fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(2316 GeneratorType generator, llvm::StringRef name,2317 std::optional<mlir::Type> resultType,2318 llvm::ArrayRef<fir::ExtendedValue> args) {2319 if (hasAbsentOptional(args))2320 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +2321 " with absent optional argument");2322 llvm::SmallVector<mlir::Value> mlirArgs;2323 for (const auto &extendedVal : args)2324 mlirArgs.emplace_back(toValue(extendedVal, builder, loc));2325 mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);2326 mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);2327 auto call = fir::CallOp::create(builder, loc, wrapper, mlirArgs);2328 if (resultType)2329 return toExtendedValue(call.getResult(0), builder, loc);2330 // Subroutine calls2331 return mlir::Value{};2332}2333 2334static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(2335 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,2336 mlir::FunctionType soughtFuncType, fir::FirOpBuilder &builder,2337 mlir::Location loc) {2338 assert(range.first != nullptr && "range should not be empty");2339 llvm::StringRef name = range.first->key;2340 // Look for a dedicated math operation generator, which2341 // normally produces a single MLIR operation implementing2342 // the math operation.2343 const MathOperation *bestNearMatch = nullptr;2344 FunctionDistance bestMatchDistance;2345 const MathOperation *mathOp = searchMathOperation(2346 builder, range, soughtFuncType, &bestNearMatch, bestMatchDistance);2347 if (!mathOp && bestNearMatch) {2348 // Use the best near match, optionally issuing an error,2349 // if types conversions cause precision loss.2350 checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, builder, loc);2351 mathOp = bestNearMatch;2352 }2353 2354 if (!mathOp) {2355 std::string nameAndType;2356 llvm::raw_string_ostream sstream(nameAndType);2357 sstream << name << "\nrequested type: " << soughtFuncType;2358 crashOnMissingIntrinsic(loc, nameAndType);2359 }2360 2361 mlir::FunctionType actualFuncType =2362 mathOp->typeGenerator(builder.getContext(), builder);2363 2364 assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&2365 actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&2366 actualFuncType.getNumResults() == 1 && "Bad intrinsic match");2367 2368 return [actualFuncType, mathOp,2369 soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,2370 llvm::ArrayRef<mlir::Value> args) {2371 llvm::SmallVector<mlir::Value> convertedArguments;2372 for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))2373 convertedArguments.push_back(builder.createConvert(loc, fst, snd));2374 mlir::Value result = mathOp->funcGenerator(2375 builder, loc, *mathOp, actualFuncType, convertedArguments);2376 mlir::Type soughtType = soughtFuncType.getResult(0);2377 return builder.createConvert(loc, soughtType, result);2378 };2379}2380 2381IntrinsicLibrary::RuntimeCallGenerator2382IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,2383 mlir::FunctionType soughtFuncType) {2384 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();2385 std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange> range =2386 lookupRuntimeGenerator(name, isPPCTarget);2387 if (!range.has_value())2388 crashOnMissingIntrinsic(loc, name);2389 return getRuntimeCallGeneratorHelper(*range, soughtFuncType, builder, loc);2390}2391 2392mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(2393 llvm::StringRef name, mlir::FunctionType signature) {2394 // Unrestricted intrinsics signature follows implicit rules: argument2395 // are passed by references. But the runtime versions expect values.2396 // So instead of duplicating the runtime, just have the wrappers loading2397 // this before calling the code generators.2398 bool loadRefArguments = true;2399 mlir::func::FuncOp funcOp;2400 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))2401 funcOp = Fortran::common::visit(2402 [&](auto generator) {2403 return getWrapper(generator, name, signature, loadRefArguments);2404 },2405 handler->generator);2406 2407 if (!funcOp) {2408 llvm::SmallVector<mlir::Type> argTypes;2409 for (mlir::Type type : signature.getInputs()) {2410 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type))2411 argTypes.push_back(refType.getEleTy());2412 else2413 argTypes.push_back(type);2414 }2415 mlir::FunctionType soughtFuncType =2416 builder.getFunctionType(argTypes, signature.getResults());2417 IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =2418 getRuntimeCallGenerator(name, soughtFuncType);2419 funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);2420 }2421 2422 return mlir::SymbolRefAttr::get(funcOp);2423}2424 2425fir::ExtendedValue2426IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,2427 mlir::Type resultType,2428 llvm::StringRef intrinsicName) {2429 fir::ExtendedValue res =2430 fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);2431 return res.match(2432 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {2433 setResultMustBeFreed();2434 return box;2435 },2436 [&](const fir::BoxValue &box) -> fir::ExtendedValue {2437 setResultMustBeFreed();2438 return box;2439 },2440 [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {2441 setResultMustBeFreed();2442 return box;2443 },2444 [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {2445 auto load = fir::LoadOp::create(builder, loc, resultType, tempAddr);2446 // Temp can be freed right away since it was loaded.2447 fir::FreeMemOp::create(builder, loc, tempAddr);2448 return load;2449 },2450 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {2451 setResultMustBeFreed();2452 return box;2453 },2454 [&](const auto &) -> fir::ExtendedValue {2455 fir::emitFatalError(loc, "unexpected result for " + intrinsicName);2456 });2457}2458 2459//===----------------------------------------------------------------------===//2460// Code generators for the intrinsic2461//===----------------------------------------------------------------------===//2462 2463mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,2464 mlir::Type resultType,2465 llvm::ArrayRef<mlir::Value> args) {2466 mlir::FunctionType soughtFuncType =2467 getFunctionType(resultType, args, builder);2468 return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);2469}2470 2471mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,2472 llvm::ArrayRef<mlir::Value> args) {2473 // There can be an optional kind in second argument.2474 assert(args.size() >= 1);2475 return builder.convertWithSemantics(loc, resultType, args[0]);2476}2477 2478// ABORT2479void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {2480 assert(args.size() == 0);2481 fir::runtime::genAbort(builder, loc);2482}2483 2484// ABS2485mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,2486 llvm::ArrayRef<mlir::Value> args) {2487 assert(args.size() == 1);2488 mlir::Value arg = args[0];2489 mlir::Type type = arg.getType();2490 if (fir::isa_real(type) || fir::isa_complex(type)) {2491 // Runtime call to fp abs. An alternative would be to use mlir2492 // math::AbsFOp but it does not support all fir floating point types.2493 return genRuntimeCall("abs", resultType, args);2494 }2495 if (auto intType = mlir::dyn_cast<mlir::IntegerType>(type)) {2496 // At the time of this implementation there is no abs op in mlir.2497 // So, implement abs here without branching.2498 mlir::Value shift =2499 builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);2500 auto mask = mlir::arith::ShRSIOp::create(builder, loc, arg, shift);2501 auto xored = mlir::arith::XOrIOp::create(builder, loc, arg, mask);2502 return mlir::arith::SubIOp::create(builder, loc, xored, mask);2503 }2504 llvm_unreachable("unexpected type in ABS argument");2505}2506 2507// ACOSD2508mlir::Value IntrinsicLibrary::genAcosd(mlir::Type resultType,2509 llvm::ArrayRef<mlir::Value> args) {2510 // maps ACOSD to ACOS * 180 / pi2511 assert(args.size() == 1);2512 mlir::MLIRContext *context = builder.getContext();2513 mlir::FunctionType ftype =2514 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2515 mlir::Value result =2516 getRuntimeCallGenerator("acos", ftype)(builder, loc, {args[0]});2517 const llvm::fltSemantics &fltSem =2518 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();2519 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);2520 mlir::Value factor = builder.createRealConstant(2521 loc, resultType, llvm::APFloat(fltSem, "180.0") / pi);2522 return mlir::arith::MulFOp::create(builder, loc, result, factor);2523}2524 2525// ACOSPI2526mlir::Value IntrinsicLibrary::genAcospi(mlir::Type resultType,2527 llvm::ArrayRef<mlir::Value> args) {2528 assert(args.size() == 1);2529 mlir::MLIRContext *context = builder.getContext();2530 mlir::FunctionType ftype =2531 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2532 mlir::Value acos = getRuntimeCallGenerator("acos", ftype)(builder, loc, args);2533 llvm::APFloat inv_pi =2534 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),2535 llvm::numbers::inv_pis);2536 mlir::Value factor = builder.createRealConstant(loc, resultType, inv_pi);2537 return mlir::arith::MulFOp::create(builder, loc, acos, factor);2538}2539 2540// ADJUSTL & ADJUSTR2541template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,2542 mlir::Value, mlir::Value)>2543fir::ExtendedValue2544IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,2545 llvm::ArrayRef<fir::ExtendedValue> args) {2546 assert(args.size() == 1);2547 mlir::Value string = builder.createBox(loc, args[0]);2548 // Create a mutable fir.box to be passed to the runtime for the result.2549 fir::MutableBoxValue resultMutableBox =2550 fir::factory::createTempMutableBox(builder, loc, resultType);2551 mlir::Value resultIrBox =2552 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);2553 2554 // Call the runtime -- the runtime will allocate the result.2555 CallRuntime(builder, loc, resultIrBox, string);2556 // Read result from mutable fir.box and add it to the list of temps to be2557 // finalized by the StatementContext.2558 return readAndAddCleanUp(resultMutableBox, resultType, "ADJUSTL or ADJUSTR");2559}2560 2561// AIMAG2562mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,2563 llvm::ArrayRef<mlir::Value> args) {2564 assert(args.size() == 1);2565 return fir::factory::Complex{builder, loc}.extractComplexPart(2566 args[0], /*isImagPart=*/true);2567}2568 2569// AINT2570mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,2571 llvm::ArrayRef<mlir::Value> args) {2572 assert(args.size() >= 1 && args.size() <= 2);2573 // Skip optional kind argument to search the runtime; it is already reflected2574 // in result type.2575 return genRuntimeCall("aint", resultType, {args[0]});2576}2577 2578// ALL2579fir::ExtendedValue2580IntrinsicLibrary::genAll(mlir::Type resultType,2581 llvm::ArrayRef<fir::ExtendedValue> args) {2582 2583 assert(args.size() == 2);2584 // Handle required mask argument2585 mlir::Value mask = builder.createBox(loc, args[0]);2586 2587 fir::BoxValue maskArry = builder.createBox(loc, args[0]);2588 int rank = maskArry.rank();2589 assert(rank >= 1);2590 2591 // Handle optional dim argument2592 bool absentDim = isStaticallyAbsent(args[1]);2593 mlir::Value dim =2594 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)2595 : fir::getBase(args[1]);2596 2597 if (rank == 1 || absentDim)2598 return builder.createConvert(loc, resultType,2599 fir::runtime::genAll(builder, loc, mask, dim));2600 2601 // else use the result descriptor AllDim() intrinsic2602 2603 // Create mutable fir.box to be passed to the runtime for the result.2604 2605 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);2606 fir::MutableBoxValue resultMutableBox =2607 fir::factory::createTempMutableBox(builder, loc, resultArrayType);2608 mlir::Value resultIrBox =2609 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);2610 // Call runtime. The runtime is allocating the result.2611 fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);2612 return readAndAddCleanUp(resultMutableBox, resultType, "ALL");2613}2614 2615// ALLOCATED2616fir::ExtendedValue2617IntrinsicLibrary::genAllocated(mlir::Type resultType,2618 llvm::ArrayRef<fir::ExtendedValue> args) {2619 assert(args.size() == 1);2620 return args[0].match(2621 [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {2622 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);2623 },2624 [&](const auto &) -> fir::ExtendedValue {2625 fir::emitFatalError(loc,2626 "allocated arg not lowered to MutableBoxValue");2627 });2628}2629 2630// ANINT2631mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,2632 llvm::ArrayRef<mlir::Value> args) {2633 assert(args.size() >= 1 && args.size() <= 2);2634 // Skip optional kind argument to search the runtime; it is already reflected2635 // in result type.2636 return genRuntimeCall("anint", resultType, {args[0]});2637}2638 2639// ANY2640fir::ExtendedValue2641IntrinsicLibrary::genAny(mlir::Type resultType,2642 llvm::ArrayRef<fir::ExtendedValue> args) {2643 2644 assert(args.size() == 2);2645 // Handle required mask argument2646 mlir::Value mask = builder.createBox(loc, args[0]);2647 2648 fir::BoxValue maskArry = builder.createBox(loc, args[0]);2649 int rank = maskArry.rank();2650 assert(rank >= 1);2651 2652 // Handle optional dim argument2653 bool absentDim = isStaticallyAbsent(args[1]);2654 mlir::Value dim =2655 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)2656 : fir::getBase(args[1]);2657 2658 if (rank == 1 || absentDim)2659 return builder.createConvert(loc, resultType,2660 fir::runtime::genAny(builder, loc, mask, dim));2661 2662 // else use the result descriptor AnyDim() intrinsic2663 2664 // Create mutable fir.box to be passed to the runtime for the result.2665 2666 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);2667 fir::MutableBoxValue resultMutableBox =2668 fir::factory::createTempMutableBox(builder, loc, resultArrayType);2669 mlir::Value resultIrBox =2670 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);2671 // Call runtime. The runtime is allocating the result.2672 fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);2673 return readAndAddCleanUp(resultMutableBox, resultType, "ANY");2674}2675 2676// ASIND2677mlir::Value IntrinsicLibrary::genAsind(mlir::Type resultType,2678 llvm::ArrayRef<mlir::Value> args) {2679 // maps ASIND to ASIN * 180 / pi2680 assert(args.size() == 1);2681 mlir::MLIRContext *context = builder.getContext();2682 mlir::FunctionType ftype =2683 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2684 mlir::Value result =2685 getRuntimeCallGenerator("asin", ftype)(builder, loc, {args[0]});2686 const llvm::fltSemantics &fltSem =2687 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();2688 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);2689 mlir::Value factor = builder.createRealConstant(2690 loc, resultType, llvm::APFloat(fltSem, "180.0") / pi);2691 return mlir::arith::MulFOp::create(builder, loc, result, factor);2692}2693 2694// ASINPI2695mlir::Value IntrinsicLibrary::genAsinpi(mlir::Type resultType,2696 llvm::ArrayRef<mlir::Value> args) {2697 assert(args.size() == 1);2698 mlir::MLIRContext *context = builder.getContext();2699 mlir::FunctionType ftype =2700 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2701 mlir::Value asin = getRuntimeCallGenerator("asin", ftype)(builder, loc, args);2702 llvm::APFloat inv_pi =2703 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),2704 llvm::numbers::inv_pis);2705 mlir::Value factor = builder.createRealConstant(loc, resultType, inv_pi);2706 return mlir::arith::MulFOp::create(builder, loc, asin, factor);2707}2708 2709// ATAND, ATAN2D2710mlir::Value IntrinsicLibrary::genAtand(mlir::Type resultType,2711 llvm::ArrayRef<mlir::Value> args) {2712 // assert for: atand(X), atand(Y,X), atan2d(Y,X)2713 assert(args.size() >= 1 && args.size() <= 2);2714 2715 mlir::MLIRContext *context = builder.getContext();2716 mlir::Value atan;2717 2718 // atand = atan * 180/pi2719 if (args.size() == 2) {2720 atan = mlir::math::Atan2Op::create(builder, loc, fir::getBase(args[0]),2721 fir::getBase(args[1]));2722 } else {2723 mlir::FunctionType ftype =2724 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2725 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);2726 }2727 const llvm::fltSemantics &fltSem =2728 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();2729 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);2730 mlir::Value factor = builder.createRealConstant(2731 loc, resultType, llvm::APFloat(fltSem, "180.0") / pi);2732 return mlir::arith::MulFOp::create(builder, loc, atan, factor);2733}2734 2735// ATANPI, ATAN2PI2736mlir::Value IntrinsicLibrary::genAtanpi(mlir::Type resultType,2737 llvm::ArrayRef<mlir::Value> args) {2738 // assert for: atanpi(X), atanpi(Y,X), atan2pi(Y,X)2739 assert(args.size() >= 1 && args.size() <= 2);2740 2741 mlir::Value atan;2742 mlir::MLIRContext *context = builder.getContext();2743 2744 // atanpi = atan / pi2745 if (args.size() == 2) {2746 atan = mlir::math::Atan2Op::create(builder, loc, fir::getBase(args[0]),2747 fir::getBase(args[1]));2748 } else {2749 mlir::FunctionType ftype =2750 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});2751 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);2752 }2753 llvm::APFloat inv_pi =2754 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),2755 llvm::numbers::inv_pis);2756 mlir::Value factor = builder.createRealConstant(loc, resultType, inv_pi);2757 return mlir::arith::MulFOp::create(builder, loc, atan, factor);2758}2759 2760// ASSOCIATED2761fir::ExtendedValue2762IntrinsicLibrary::genAssociated(mlir::Type resultType,2763 llvm::ArrayRef<fir::ExtendedValue> args) {2764 assert(args.size() == 2);2765 mlir::Type ptrTy = fir::getBase(args[0]).getType();2766 if (ptrTy && (fir::isBoxProcAddressType(ptrTy) ||2767 mlir::isa<fir::BoxProcType>(ptrTy))) {2768 mlir::Value pointerBoxProc =2769 fir::isBoxProcAddressType(ptrTy)2770 ? fir::LoadOp::create(builder, loc, fir::getBase(args[0]))2771 : fir::getBase(args[0]);2772 mlir::Value pointerTarget =2773 fir::BoxAddrOp::create(builder, loc, pointerBoxProc);2774 if (isStaticallyAbsent(args[1]))2775 return builder.genIsNotNullAddr(loc, pointerTarget);2776 mlir::Value target = fir::getBase(args[1]);2777 if (fir::isBoxProcAddressType(target.getType()))2778 target = fir::LoadOp::create(builder, loc, target);2779 if (mlir::isa<fir::BoxProcType>(target.getType()))2780 target = fir::BoxAddrOp::create(builder, loc, target);2781 mlir::Type intPtrTy = builder.getIntPtrType();2782 mlir::Value pointerInt =2783 builder.createConvert(loc, intPtrTy, pointerTarget);2784 mlir::Value targetInt = builder.createConvert(loc, intPtrTy, target);2785 mlir::Value sameTarget = mlir::arith::CmpIOp::create(2786 builder, loc, mlir::arith::CmpIPredicate::eq, pointerInt, targetInt);2787 mlir::Value zero = builder.createIntegerConstant(loc, intPtrTy, 0);2788 mlir::Value notNull = mlir::arith::CmpIOp::create(2789 builder, loc, mlir::arith::CmpIPredicate::ne, zero, pointerInt);2790 // The not notNull test covers the following two cases:2791 // - TARGET is a procedure that is OPTIONAL and absent at runtime.2792 // - TARGET is a procedure pointer that is NULL.2793 // In both cases, ASSOCIATED should be false if POINTER is NULL.2794 return mlir::arith::AndIOp::create(builder, loc, sameTarget, notNull);2795 }2796 auto *pointer =2797 args[0].match([&](const fir::MutableBoxValue &x) { return &x; },2798 [&](const auto &) -> const fir::MutableBoxValue * {2799 fir::emitFatalError(loc, "pointer not a MutableBoxValue");2800 });2801 const fir::ExtendedValue &target = args[1];2802 if (isStaticallyAbsent(target))2803 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);2804 mlir::Value targetBox = builder.createBox(loc, target);2805 mlir::Value pointerBoxRef =2806 fir::factory::getMutableIRBox(builder, loc, *pointer);2807 auto pointerBox = fir::LoadOp::create(builder, loc, pointerBoxRef);2808 return fir::runtime::genAssociated(builder, loc, pointerBox, targetBox);2809}2810 2811// BESSEL_JN2812fir::ExtendedValue2813IntrinsicLibrary::genBesselJn(mlir::Type resultType,2814 llvm::ArrayRef<fir::ExtendedValue> args) {2815 assert(args.size() == 2 || args.size() == 3);2816 2817 mlir::Value x = fir::getBase(args.back());2818 2819 if (args.size() == 2) {2820 mlir::Value n = fir::getBase(args[0]);2821 2822 return genRuntimeCall("bessel_jn", resultType, {n, x});2823 } else {2824 mlir::Value n1 = fir::getBase(args[0]);2825 mlir::Value n2 = fir::getBase(args[1]);2826 2827 mlir::Type intTy = n1.getType();2828 mlir::Type floatTy = x.getType();2829 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);2830 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);2831 2832 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);2833 fir::MutableBoxValue resultMutableBox =2834 fir::factory::createTempMutableBox(builder, loc, resultArrayType);2835 mlir::Value resultBox =2836 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);2837 2838 mlir::Value cmpXEq0 = mlir::arith::CmpFOp::create(2839 builder, loc, mlir::arith::CmpFPredicate::UEQ, x, zero);2840 mlir::Value cmpN1LtN2 = mlir::arith::CmpIOp::create(2841 builder, loc, mlir::arith::CmpIPredicate::slt, n1, n2);2842 mlir::Value cmpN1EqN2 = mlir::arith::CmpIOp::create(2843 builder, loc, mlir::arith::CmpIPredicate::eq, n1, n2);2844 2845 auto genXEq0 = [&]() {2846 fir::runtime::genBesselJnX0(builder, loc, floatTy, resultBox, n1, n2);2847 };2848 2849 auto genN1LtN2 = [&]() {2850 // The runtime generates the values in the range using a backward2851 // recursion from n2 to n1. (see https://dlmf.nist.gov/10.74.iv and2852 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires2853 // the values of BESSEL_JN(n2) and BESSEL_JN(n2 - 1) since they2854 // are the anchors of the recursion.2855 mlir::Value n2_1 = mlir::arith::SubIOp::create(builder, loc, n2, one);2856 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});2857 mlir::Value bn2_1 = genRuntimeCall("bessel_jn", resultType, {n2_1, x});2858 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, bn2_1);2859 };2860 2861 auto genN1EqN2 = [&]() {2862 // When n1 == n2, only BESSEL_JN(n2) is needed.2863 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});2864 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, zero);2865 };2866 2867 auto genN1GtN2 = [&]() {2868 // The standard requires n1 <= n2. However, we still need to allocate2869 // a zero-length array and return it when n1 > n2, so we do need to call2870 // the runtime function.2871 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, zero, zero);2872 };2873 2874 auto genN1GeN2 = [&] {2875 builder.genIfThenElse(loc, cmpN1EqN2)2876 .genThen(genN1EqN2)2877 .genElse(genN1GtN2)2878 .end();2879 };2880 2881 auto genXNeq0 = [&]() {2882 builder.genIfThenElse(loc, cmpN1LtN2)2883 .genThen(genN1LtN2)2884 .genElse(genN1GeN2)2885 .end();2886 };2887 2888 builder.genIfThenElse(loc, cmpXEq0)2889 .genThen(genXEq0)2890 .genElse(genXNeq0)2891 .end();2892 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_JN");2893 }2894}2895 2896// BESSEL_YN2897fir::ExtendedValue2898IntrinsicLibrary::genBesselYn(mlir::Type resultType,2899 llvm::ArrayRef<fir::ExtendedValue> args) {2900 assert(args.size() == 2 || args.size() == 3);2901 2902 mlir::Value x = fir::getBase(args.back());2903 2904 if (args.size() == 2) {2905 mlir::Value n = fir::getBase(args[0]);2906 2907 return genRuntimeCall("bessel_yn", resultType, {n, x});2908 } else {2909 mlir::Value n1 = fir::getBase(args[0]);2910 mlir::Value n2 = fir::getBase(args[1]);2911 2912 mlir::Type floatTy = x.getType();2913 mlir::Type intTy = n1.getType();2914 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);2915 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);2916 2917 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);2918 fir::MutableBoxValue resultMutableBox =2919 fir::factory::createTempMutableBox(builder, loc, resultArrayType);2920 mlir::Value resultBox =2921 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);2922 2923 mlir::Value cmpXEq0 = mlir::arith::CmpFOp::create(2924 builder, loc, mlir::arith::CmpFPredicate::UEQ, x, zero);2925 mlir::Value cmpN1LtN2 = mlir::arith::CmpIOp::create(2926 builder, loc, mlir::arith::CmpIPredicate::slt, n1, n2);2927 mlir::Value cmpN1EqN2 = mlir::arith::CmpIOp::create(2928 builder, loc, mlir::arith::CmpIPredicate::eq, n1, n2);2929 2930 auto genXEq0 = [&]() {2931 fir::runtime::genBesselYnX0(builder, loc, floatTy, resultBox, n1, n2);2932 };2933 2934 auto genN1LtN2 = [&]() {2935 // The runtime generates the values in the range using a forward2936 // recursion from n1 to n2. (see https://dlmf.nist.gov/10.74.iv and2937 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires2938 // the values of BESSEL_YN(n1) and BESSEL_YN(n1 + 1) since they2939 // are the anchors of the recursion.2940 mlir::Value n1_1 = mlir::arith::AddIOp::create(builder, loc, n1, one);2941 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});2942 mlir::Value bn1_1 = genRuntimeCall("bessel_yn", resultType, {n1_1, x});2943 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, bn1_1);2944 };2945 2946 auto genN1EqN2 = [&]() {2947 // When n1 == n2, only BESSEL_YN(n1) is needed.2948 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});2949 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, zero);2950 };2951 2952 auto genN1GtN2 = [&]() {2953 // The standard requires n1 <= n2. However, we still need to allocate2954 // a zero-length array and return it when n1 > n2, so we do need to call2955 // the runtime function.2956 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, zero, zero);2957 };2958 2959 auto genN1GeN2 = [&] {2960 builder.genIfThenElse(loc, cmpN1EqN2)2961 .genThen(genN1EqN2)2962 .genElse(genN1GtN2)2963 .end();2964 };2965 2966 auto genXNeq0 = [&]() {2967 builder.genIfThenElse(loc, cmpN1LtN2)2968 .genThen(genN1LtN2)2969 .genElse(genN1GeN2)2970 .end();2971 };2972 2973 builder.genIfThenElse(loc, cmpXEq0)2974 .genThen(genXEq0)2975 .genElse(genXNeq0)2976 .end();2977 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_YN");2978 }2979}2980 2981// BGE, BGT, BLE, BLT2982template <mlir::arith::CmpIPredicate pred>2983mlir::Value2984IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,2985 llvm::ArrayRef<mlir::Value> args) {2986 assert(args.size() == 2);2987 2988 mlir::Value arg0 = args[0];2989 mlir::Value arg1 = args[1];2990 mlir::Type arg0Ty = arg0.getType();2991 mlir::Type arg1Ty = arg1.getType();2992 int bits0 = arg0Ty.getIntOrFloatBitWidth();2993 int bits1 = arg1Ty.getIntOrFloatBitWidth();2994 2995 // Arguments do not have to be of the same integer type. However, if neither2996 // of the arguments is a BOZ literal, then the shorter of the two needs2997 // to be converted to the longer by zero-extending (not sign-extending)2998 // to the left [Fortran 2008, 13.3.2].2999 //3000 // In the case of BOZ literals, the standard describes zero-extension or3001 // truncation depending on the kind of the result [Fortran 2008, 13.3.3].3002 // However, that seems to be relevant for the case where the type of the3003 // result must match the type of the BOZ literal. That is not the case for3004 // these intrinsics, so, again, zero-extend to the larger type.3005 int widest = bits0 > bits1 ? bits0 : bits1;3006 mlir::Type signlessType =3007 mlir::IntegerType::get(builder.getContext(), widest,3008 mlir::IntegerType::SignednessSemantics::Signless);3009 if (arg0Ty.isUnsignedInteger())3010 arg0 = builder.createConvert(loc, signlessType, arg0);3011 else if (bits0 < widest)3012 arg0 = mlir::arith::ExtUIOp::create(builder, loc, signlessType, arg0);3013 if (arg1Ty.isUnsignedInteger())3014 arg1 = builder.createConvert(loc, signlessType, arg1);3015 else if (bits1 < widest)3016 arg1 = mlir::arith::ExtUIOp::create(builder, loc, signlessType, arg1);3017 return mlir::arith::CmpIOp::create(builder, loc, pred, arg0, arg1);3018}3019 3020// BTEST3021mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,3022 llvm::ArrayRef<mlir::Value> args) {3023 // A conformant BTEST(I,POS) call satisfies:3024 // POS >= 03025 // POS < BIT_SIZE(I)3026 // Return: (I >> POS) & 13027 assert(args.size() == 2);3028 mlir::Value word = args[0];3029 mlir::Type signlessType = mlir::IntegerType::get(3030 builder.getContext(), word.getType().getIntOrFloatBitWidth(),3031 mlir::IntegerType::SignednessSemantics::Signless);3032 if (word.getType().isUnsignedInteger())3033 word = builder.createConvert(loc, signlessType, word);3034 mlir::Value shiftCount = builder.createConvert(loc, signlessType, args[1]);3035 mlir::Value shifted =3036 mlir::arith::ShRUIOp::create(builder, loc, word, shiftCount);3037 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);3038 mlir::Value bit = mlir::arith::AndIOp::create(builder, loc, shifted, one);3039 return builder.createConvert(loc, resultType, bit);3040}3041 3042static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder,3043 mlir::Location loc, fir::ExtendedValue arg,3044 bool isFunc) {3045 mlir::Value argValue = fir::getBase(arg);3046 mlir::Value addr{nullptr};3047 if (isFunc) {3048 auto funcTy = mlir::cast<fir::BoxProcType>(argValue.getType()).getEleTy();3049 addr = fir::BoxAddrOp::create(builder, loc, funcTy, argValue);3050 } else {3051 const auto *box = arg.getBoxOf<fir::BoxValue>();3052 addr = fir::BoxAddrOp::create(builder, loc, box->getMemTy(),3053 fir::getBase(*box));3054 }3055 return addr;3056}3057 3058static void clocDeviceArgRewrite(fir::ExtendedValue arg) {3059 // Special case for device address in c_loc.3060 if (auto emboxOp = mlir::dyn_cast_or_null<fir::EmboxOp>(3061 fir::getBase(arg).getDefiningOp()))3062 if (auto declareOp = mlir::dyn_cast_or_null<hlfir::DeclareOp>(3063 emboxOp.getMemref().getDefiningOp()))3064 if (declareOp.getDataAttr() &&3065 declareOp.getDataAttr() == cuf::DataAttribute::Device)3066 emboxOp.getMemrefMutable().assign(declareOp.getMemref());3067}3068 3069static fir::ExtendedValue3070genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,3071 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,3072 bool isFunc = false, bool isDevLoc = false) {3073 assert(args.size() == 1);3074 clocDeviceArgRewrite(args[0]);3075 mlir::Value res = fir::AllocaOp::create(builder, loc, resultType);3076 mlir::Value resAddr;3077 if (isDevLoc)3078 resAddr = fir::factory::genCDevPtrAddr(builder, loc, res, resultType);3079 else3080 resAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType);3081 assert(fir::isa_box_type(fir::getBase(args[0]).getType()) &&3082 "argument must have been lowered to box type");3083 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);3084 mlir::Value argAddrVal = builder.createConvert(3085 loc, fir::unwrapRefType(resAddr.getType()), argAddr);3086 fir::StoreOp::create(builder, loc, argAddrVal, resAddr);3087 return res;3088}3089 3090/// C_ASSOCIATED3091static fir::ExtendedValue3092genCAssociated(fir::FirOpBuilder &builder, mlir::Location loc,3093 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {3094 assert(args.size() == 2);3095 mlir::Value cPtr1 = fir::getBase(args[0]);3096 mlir::Value cPtrVal1 =3097 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);3098 mlir::Value zero = builder.createIntegerConstant(loc, cPtrVal1.getType(), 0);3099 mlir::Value res = mlir::arith::CmpIOp::create(3100 builder, loc, mlir::arith::CmpIPredicate::ne, cPtrVal1, zero);3101 3102 if (isStaticallyPresent(args[1])) {3103 mlir::Type i1Ty = builder.getI1Type();3104 mlir::Value cPtr2 = fir::getBase(args[1]);3105 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, cPtr2);3106 res =3107 builder3108 .genIfOp(loc, {i1Ty}, isDynamicallyAbsent, /*withElseRegion=*/true)3109 .genThen([&]() { fir::ResultOp::create(builder, loc, res); })3110 .genElse([&]() {3111 mlir::Value cPtrVal2 =3112 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);3113 mlir::Value cmpVal = mlir::arith::CmpIOp::create(3114 builder, loc, mlir::arith::CmpIPredicate::eq, cPtrVal1,3115 cPtrVal2);3116 mlir::Value newRes =3117 mlir::arith::AndIOp::create(builder, loc, res, cmpVal);3118 fir::ResultOp::create(builder, loc, newRes);3119 })3120 .getResults()[0];3121 }3122 return builder.createConvert(loc, resultType, res);3123}3124 3125/// C_ASSOCIATED (C_FUNPTR [, C_FUNPTR])3126fir::ExtendedValue IntrinsicLibrary::genCAssociatedCFunPtr(3127 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {3128 return genCAssociated(builder, loc, resultType, args);3129}3130 3131/// C_ASSOCIATED (C_PTR [, C_PTR])3132fir::ExtendedValue3133IntrinsicLibrary::genCAssociatedCPtr(mlir::Type resultType,3134 llvm::ArrayRef<fir::ExtendedValue> args) {3135 return genCAssociated(builder, loc, resultType, args);3136}3137 3138// C_DEVLOC3139fir::ExtendedValue3140IntrinsicLibrary::genCDevLoc(mlir::Type resultType,3141 llvm::ArrayRef<fir::ExtendedValue> args) {3142 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/false,3143 /*isDevLoc=*/true);3144}3145 3146// C_F_POINTER3147void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {3148 assert(args.size() == 4);3149 // Handle CPTR argument3150 // Get the value of the C address or the result of a reference to C_LOC.3151 mlir::Value cPtr = fir::getBase(args[0]);3152 mlir::Value cPtrAddrVal =3153 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr);3154 3155 // Handle FPTR argument3156 const auto *fPtr = args[1].getBoxOf<fir::MutableBoxValue>();3157 assert(fPtr && "FPTR must be a pointer");3158 3159 auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue {3160 mlir::Value addr =3161 builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);3162 mlir::SmallVector<mlir::Value> extents;3163 mlir::SmallVector<mlir::Value> lbounds;3164 if (box.hasRank()) {3165 assert(isStaticallyPresent(args[2]) &&3166 "FPTR argument must be an array if SHAPE argument exists");3167 3168 // Handle and unpack SHAPE argument3169 mlir::Value shape = fir::getBase(args[2]);3170 int arrayRank = box.rank();3171 mlir::Type shapeElementType =3172 fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType()));3173 mlir::Type idxType = builder.getIndexType();3174 for (int i = 0; i < arrayRank; ++i) {3175 mlir::Value index = builder.createIntegerConstant(loc, idxType, i);3176 mlir::Value var = fir::CoordinateOp::create(3177 builder, loc, builder.getRefType(shapeElementType), shape, index);3178 mlir::Value load = fir::LoadOp::create(builder, loc, var);3179 extents.push_back(builder.createConvert(loc, idxType, load));3180 }3181 3182 // Handle and unpack LOWER argument if present3183 if (isStaticallyPresent(args[3])) {3184 mlir::Value lower = fir::getBase(args[3]);3185 mlir::Type lowerElementType =3186 fir::unwrapSequenceType(fir::unwrapPassByRefType(lower.getType()));3187 for (int i = 0; i < arrayRank; ++i) {3188 mlir::Value index = builder.createIntegerConstant(loc, idxType, i);3189 mlir::Value var = fir::CoordinateOp::create(3190 builder, loc, builder.getRefType(lowerElementType), lower, index);3191 mlir::Value load = fir::LoadOp::create(builder, loc, var);3192 lbounds.push_back(builder.createConvert(loc, idxType, load));3193 }3194 }3195 }3196 if (box.isCharacter()) {3197 mlir::Value len = box.nonDeferredLenParams()[0];3198 if (box.hasRank())3199 return fir::CharArrayBoxValue{addr, len, extents, lbounds};3200 return fir::CharBoxValue{addr, len};3201 }3202 if (box.isDerivedWithLenParameters())3203 TODO(loc, "get length parameters of derived type");3204 if (box.hasRank())3205 return fir::ArrayBoxValue{addr, extents, lbounds};3206 return addr;3207 };3208 3209 fir::factory::associateMutableBox(builder, loc, *fPtr, getCPtrExtVal(*fPtr),3210 /*lbounds=*/mlir::ValueRange{});3211 3212 // If the pointer is a registered CUDA fortran variable, the descriptor needs3213 // to be synced.3214 if (auto declare = mlir::dyn_cast_or_null<hlfir::DeclareOp>(3215 fPtr->getAddr().getDefiningOp()))3216 if (declare.getMemref().getDefiningOp() &&3217 mlir::isa<fir::AddrOfOp>(declare.getMemref().getDefiningOp()))3218 if (cuf::isRegisteredDeviceAttr(declare.getDataAttr()) &&3219 !cuf::isCUDADeviceContext(builder.getRegion()))3220 fir::runtime::cuda::genSyncGlobalDescriptor(builder, loc,3221 declare.getMemref());3222}3223 3224// C_F_PROCPOINTER3225void IntrinsicLibrary::genCFProcPointer(3226 llvm::ArrayRef<fir::ExtendedValue> args) {3227 assert(args.size() == 2);3228 mlir::Value cptr =3229 fir::factory::genCPtrOrCFunptrValue(builder, loc, fir::getBase(args[0]));3230 mlir::Value fptr = fir::getBase(args[1]);3231 auto boxProcType =3232 mlir::cast<fir::BoxProcType>(fir::unwrapRefType(fptr.getType()));3233 mlir::Value cptrCast =3234 builder.createConvert(loc, boxProcType.getEleTy(), cptr);3235 mlir::Value cptrBox =3236 fir::EmboxProcOp::create(builder, loc, boxProcType, cptrCast);3237 fir::StoreOp::create(builder, loc, cptrBox, fptr);3238}3239 3240// C_FUNLOC3241fir::ExtendedValue3242IntrinsicLibrary::genCFunLoc(mlir::Type resultType,3243 llvm::ArrayRef<fir::ExtendedValue> args) {3244 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true);3245}3246 3247// C_LOC3248fir::ExtendedValue3249IntrinsicLibrary::genCLoc(mlir::Type resultType,3250 llvm::ArrayRef<fir::ExtendedValue> args) {3251 return genCLocOrCFunLoc(builder, loc, resultType, args);3252}3253 3254// C_PTR_EQ and C_PTR_NE3255template <mlir::arith::CmpIPredicate pred>3256fir::ExtendedValue3257IntrinsicLibrary::genCPtrCompare(mlir::Type resultType,3258 llvm::ArrayRef<fir::ExtendedValue> args) {3259 assert(args.size() == 2);3260 mlir::Value cPtr1 = fir::getBase(args[0]);3261 mlir::Value cPtrVal1 =3262 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);3263 mlir::Value cPtr2 = fir::getBase(args[1]);3264 mlir::Value cPtrVal2 =3265 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);3266 mlir::Value cmp =3267 mlir::arith::CmpIOp::create(builder, loc, pred, cPtrVal1, cPtrVal2);3268 return builder.createConvert(loc, resultType, cmp);3269}3270 3271// CEILING3272mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,3273 llvm::ArrayRef<mlir::Value> args) {3274 // Optional KIND argument.3275 assert(args.size() >= 1);3276 mlir::Value arg = args[0];3277 // Use ceil that is not an actual Fortran intrinsic but that is3278 // an llvm intrinsic that does the same, but return a floating3279 // point.3280 mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});3281 return builder.createConvert(loc, resultType, ceil);3282}3283 3284// CHAR3285fir::ExtendedValue3286IntrinsicLibrary::genChar(mlir::Type type,3287 llvm::ArrayRef<fir::ExtendedValue> args) {3288 // Optional KIND argument.3289 assert(args.size() >= 1);3290 const mlir::Value *arg = args[0].getUnboxed();3291 // expect argument to be a scalar integer3292 if (!arg)3293 mlir::emitError(loc, "CHAR intrinsic argument not unboxed");3294 fir::factory::CharacterExprHelper helper{builder, loc};3295 fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();3296 mlir::Value cast = helper.createSingletonFromCode(*arg, kind);3297 mlir::Value len =3298 builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);3299 return fir::CharBoxValue{cast, len};3300}3301 3302// CHDIR3303fir::ExtendedValue3304IntrinsicLibrary::genChdir(std::optional<mlir::Type> resultType,3305 llvm::ArrayRef<fir::ExtendedValue> args) {3306 assert((args.size() == 1 && resultType.has_value()) ||3307 (args.size() >= 1 && !resultType.has_value()));3308 mlir::Value name = fir::getBase(args[0]);3309 mlir::Value status = fir::runtime::genChdir(builder, loc, name);3310 3311 if (resultType.has_value()) {3312 return status;3313 } else {3314 // Subroutine form, store status and return none.3315 if (!isStaticallyAbsent(args[1])) {3316 mlir::Value statusAddr = fir::getBase(args[1]);3317 statusAddr.dump();3318 mlir::Value statusIsPresentAtRuntime =3319 builder.genIsNotNullAddr(loc, statusAddr);3320 builder.genIfThen(loc, statusIsPresentAtRuntime)3321 .genThen([&]() {3322 builder.createStoreWithConvert(loc, status, statusAddr);3323 })3324 .end();3325 }3326 }3327 3328 return {};3329}3330 3331// CMPLX3332mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,3333 llvm::ArrayRef<mlir::Value> args) {3334 assert(args.size() >= 1);3335 fir::factory::Complex complexHelper(builder, loc);3336 mlir::Type partType = complexHelper.getComplexPartType(resultType);3337 mlir::Value real = builder.createConvert(loc, partType, args[0]);3338 mlir::Value imag = isStaticallyAbsent(args, 1)3339 ? builder.createRealZeroConstant(loc, partType)3340 : builder.createConvert(loc, partType, args[1]);3341 return fir::factory::Complex{builder, loc}.createComplex(resultType, real,3342 imag);3343}3344 3345// CO_BROADCAST3346void IntrinsicLibrary::genCoBroadcast(llvm::ArrayRef<fir::ExtendedValue> args) {3347 converter->checkCoarrayEnabled();3348 assert(args.size() == 4);3349 mif::CoBroadcastOp::create(builder, loc, fir::getBase(args[0]),3350 /*sourceImage*/ fir::getBase(args[1]),3351 /*status*/ fir::getBase(args[2]),3352 /*errmsg*/ fir::getBase(args[3]));3353}3354 3355// CO_MAX3356void IntrinsicLibrary::genCoMax(llvm::ArrayRef<fir::ExtendedValue> args) {3357 converter->checkCoarrayEnabled();3358 assert(args.size() == 4);3359 mif::CoMaxOp::create(builder, loc, fir::getBase(args[0]),3360 /*resultImage*/ fir::getBase(args[1]),3361 /*status*/ fir::getBase(args[2]),3362 /*errmsg*/ fir::getBase(args[3]));3363}3364 3365// CO_MIN3366void IntrinsicLibrary::genCoMin(llvm::ArrayRef<fir::ExtendedValue> args) {3367 converter->checkCoarrayEnabled();3368 assert(args.size() == 4);3369 mif::CoMinOp::create(builder, loc, fir::getBase(args[0]),3370 /*resultImage*/ fir::getBase(args[1]),3371 /*status*/ fir::getBase(args[2]),3372 /*errmsg*/ fir::getBase(args[3]));3373}3374 3375// CO_SUM3376void IntrinsicLibrary::genCoSum(llvm::ArrayRef<fir::ExtendedValue> args) {3377 converter->checkCoarrayEnabled();3378 assert(args.size() == 4);3379 mif::CoSumOp::create(builder, loc, fir::getBase(args[0]),3380 /*resultImage*/ fir::getBase(args[1]),3381 /*status*/ fir::getBase(args[2]),3382 /*errmsg*/ fir::getBase(args[3]));3383}3384 3385// COMMAND_ARGUMENT_COUNT3386fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(3387 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {3388 assert(args.size() == 0);3389 assert(resultType == builder.getDefaultIntegerType() &&3390 "result type is not default integer kind type");3391 return builder.createConvert(3392 loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));3393 ;3394}3395 3396// CONJG3397mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,3398 llvm::ArrayRef<mlir::Value> args) {3399 assert(args.size() == 1);3400 if (resultType != args[0].getType())3401 llvm_unreachable("argument type mismatch");3402 3403 mlir::Value cplx = args[0];3404 auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(3405 cplx, /*isImagPart=*/true);3406 auto negImag = mlir::arith::NegFOp::create(builder, loc, imag);3407 return fir::factory::Complex{builder, loc}.insertComplexPart(3408 cplx, negImag, /*isImagPart=*/true);3409}3410 3411// COSD3412mlir::Value IntrinsicLibrary::genCosd(mlir::Type resultType,3413 llvm::ArrayRef<mlir::Value> args) {3414 assert(args.size() == 1);3415 mlir::MLIRContext *context = builder.getContext();3416 mlir::FunctionType ftype =3417 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});3418 const llvm::fltSemantics &fltSem =3419 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();3420 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);3421 mlir::Value factor = builder.createRealConstant(3422 loc, resultType, pi / llvm::APFloat(fltSem, "180.0"));3423 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);3424 return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg});3425}3426 3427// COSPI3428mlir::Value IntrinsicLibrary::genCospi(mlir::Type resultType,3429 llvm::ArrayRef<mlir::Value> args) {3430 assert(args.size() == 1);3431 mlir::MLIRContext *context = builder.getContext();3432 mlir::FunctionType ftype =3433 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});3434 llvm::APFloat pi =3435 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),3436 llvm::numbers::pis);3437 mlir::Value factor = builder.createRealConstant(loc, resultType, pi);3438 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);3439 return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg});3440}3441 3442// COUNT3443fir::ExtendedValue3444IntrinsicLibrary::genCount(mlir::Type resultType,3445 llvm::ArrayRef<fir::ExtendedValue> args) {3446 assert(args.size() == 3);3447 3448 // Handle mask argument3449 fir::BoxValue mask = builder.createBox(loc, args[0]);3450 unsigned maskRank = mask.rank();3451 3452 assert(maskRank > 0);3453 3454 // Handle optional dim argument3455 bool absentDim = isStaticallyAbsent(args[1]);3456 mlir::Value dim =3457 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)3458 : fir::getBase(args[1]);3459 3460 if (absentDim || maskRank == 1) {3461 // Result is scalar if no dim argument or mask is rank 1.3462 // So, call specialized Count runtime routine.3463 return builder.createConvert(3464 loc, resultType,3465 fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));3466 }3467 3468 // Call general CountDim runtime routine.3469 3470 // Handle optional kind argument3471 bool absentKind = isStaticallyAbsent(args[2]);3472 mlir::Value kind = absentKind ? builder.createIntegerConstant(3473 loc, builder.getIndexType(),3474 builder.getKindMap().defaultIntegerKind())3475 : fir::getBase(args[2]);3476 3477 // Create mutable fir.box to be passed to the runtime for the result.3478 mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);3479 fir::MutableBoxValue resultMutableBox =3480 fir::factory::createTempMutableBox(builder, loc, type);3481 3482 mlir::Value resultIrBox =3483 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);3484 3485 fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,3486 kind);3487 // Handle cleanup of allocatable result descriptor and return3488 return readAndAddCleanUp(resultMutableBox, resultType, "COUNT");3489}3490 3491// CPU_TIME3492void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {3493 assert(args.size() == 1);3494 const mlir::Value *arg = args[0].getUnboxed();3495 assert(arg && "nonscalar cpu_time argument");3496 mlir::Value res1 = fir::runtime::genCpuTime(builder, loc);3497 mlir::Value res2 =3498 builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);3499 fir::StoreOp::create(builder, loc, res2, *arg);3500}3501 3502// CSHIFT3503fir::ExtendedValue3504IntrinsicLibrary::genCshift(mlir::Type resultType,3505 llvm::ArrayRef<fir::ExtendedValue> args) {3506 assert(args.size() == 3);3507 3508 // Handle required ARRAY argument3509 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);3510 mlir::Value array = fir::getBase(arrayBox);3511 unsigned arrayRank = arrayBox.rank();3512 3513 // Create mutable fir.box to be passed to the runtime for the result.3514 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);3515 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(3516 builder, loc, resultArrayType, {},3517 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});3518 mlir::Value resultIrBox =3519 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);3520 3521 if (arrayRank == 1) {3522 // Vector case3523 // Handle required SHIFT argument as a scalar3524 const mlir::Value *shiftAddr = args[1].getUnboxed();3525 assert(shiftAddr && "nonscalar CSHIFT argument");3526 auto shift = fir::LoadOp::create(builder, loc, *shiftAddr);3527 3528 fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);3529 } else {3530 // Non-vector case3531 // Handle required SHIFT argument as an array3532 mlir::Value shift = builder.createBox(loc, args[1]);3533 3534 // Handle optional DIM argument3535 mlir::Value dim =3536 isStaticallyAbsent(args[2])3537 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)3538 : fir::getBase(args[2]);3539 fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);3540 }3541 return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");3542}3543 3544// DATE_AND_TIME3545void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {3546 assert(args.size() == 4 && "date_and_time has 4 args");3547 llvm::SmallVector<std::optional<fir::CharBoxValue>> charArgs(3);3548 for (unsigned i = 0; i < 3; ++i)3549 if (const fir::CharBoxValue *charBox = args[i].getCharBox())3550 charArgs[i] = *charBox;3551 3552 mlir::Value values = fir::getBase(args[3]);3553 if (!values)3554 values = fir::AbsentOp::create(builder, loc,3555 fir::BoxType::get(builder.getNoneType()));3556 3557 fir::runtime::genDateAndTime(builder, loc, charArgs[0], charArgs[1],3558 charArgs[2], values);3559}3560 3561// DIM3562mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,3563 llvm::ArrayRef<mlir::Value> args) {3564 assert(args.size() == 2);3565 if (mlir::isa<mlir::IntegerType>(resultType)) {3566 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);3567 auto diff = mlir::arith::SubIOp::create(builder, loc, args[0], args[1]);3568 auto cmp = mlir::arith::CmpIOp::create(3569 builder, loc, mlir::arith::CmpIPredicate::sgt, diff, zero);3570 return mlir::arith::SelectOp::create(builder, loc, cmp, diff, zero);3571 }3572 assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");3573 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);3574 auto diff = mlir::arith::SubFOp::create(builder, loc, args[0], args[1]);3575 auto cmp = mlir::arith::CmpFOp::create(3576 builder, loc, mlir::arith::CmpFPredicate::OGT, diff, zero);3577 return mlir::arith::SelectOp::create(builder, loc, cmp, diff, zero);3578}3579 3580// DOT_PRODUCT3581fir::ExtendedValue3582IntrinsicLibrary::genDotProduct(mlir::Type resultType,3583 llvm::ArrayRef<fir::ExtendedValue> args) {3584 assert(args.size() == 2);3585 3586 // Handle required vector arguments3587 mlir::Value vectorA = fir::getBase(args[0]);3588 mlir::Value vectorB = fir::getBase(args[1]);3589 // Result type is used for picking appropriate runtime function.3590 mlir::Type eleTy = resultType;3591 3592 if (fir::isa_complex(eleTy)) {3593 mlir::Value result = builder.createTemporary(loc, eleTy);3594 fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, result);3595 return fir::LoadOp::create(builder, loc, result);3596 }3597 3598 // This operation is only used to pass the result type3599 // information to the DotProduct generator.3600 auto resultBox =3601 fir::AbsentOp::create(builder, loc, fir::BoxType::get(eleTy));3602 return fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, resultBox);3603}3604 3605// DPROD3606mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,3607 llvm::ArrayRef<mlir::Value> args) {3608 assert(args.size() == 2);3609 assert(fir::isa_real(resultType) &&3610 "Result must be double precision in DPROD");3611 mlir::Value a = builder.createConvert(loc, resultType, args[0]);3612 mlir::Value b = builder.createConvert(loc, resultType, args[1]);3613 return mlir::arith::MulFOp::create(builder, loc, a, b);3614}3615 3616// DSECNDS3617// Double precision variant of SECNDS (PGI extension)3618fir::ExtendedValue3619IntrinsicLibrary::genDsecnds(mlir::Type resultType,3620 llvm::ArrayRef<fir::ExtendedValue> args) {3621 assert(args.size() == 1 && "DSECNDS expects one argument");3622 3623 mlir::Value refTime = fir::getBase(args[0]);3624 3625 if (!refTime)3626 fir::emitFatalError(loc, "expected REFERENCE TIME parameter");3627 3628 mlir::Value result = fir::runtime::genDsecnds(builder, loc, refTime);3629 3630 return builder.createConvert(loc, resultType, result);3631}3632 3633// DSHIFTL3634mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,3635 llvm::ArrayRef<mlir::Value> args) {3636 assert(args.size() == 3);3637 3638 mlir::Value i = args[0];3639 mlir::Value j = args[1];3640 int bits = resultType.getIntOrFloatBitWidth();3641 mlir::Type signlessType =3642 mlir::IntegerType::get(builder.getContext(), bits,3643 mlir::IntegerType::SignednessSemantics::Signless);3644 if (resultType.isUnsignedInteger()) {3645 i = builder.createConvert(loc, signlessType, i);3646 j = builder.createConvert(loc, signlessType, j);3647 }3648 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);3649 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);3650 3651 // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to3652 // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))3653 mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, bitSize, shift);3654 3655 mlir::Value lArgs[2]{i, shift};3656 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);3657 3658 mlir::Value rArgs[2]{j, diff};3659 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);3660 mlir::Value result = mlir::arith::OrIOp::create(builder, loc, lft, rgt);3661 if (resultType.isUnsignedInteger())3662 return builder.createConvert(loc, resultType, result);3663 return result;3664}3665 3666// DSHIFTR3667mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,3668 llvm::ArrayRef<mlir::Value> args) {3669 assert(args.size() == 3);3670 3671 mlir::Value i = args[0];3672 mlir::Value j = args[1];3673 int bits = resultType.getIntOrFloatBitWidth();3674 mlir::Type signlessType =3675 mlir::IntegerType::get(builder.getContext(), bits,3676 mlir::IntegerType::SignednessSemantics::Signless);3677 if (resultType.isUnsignedInteger()) {3678 i = builder.createConvert(loc, signlessType, i);3679 j = builder.createConvert(loc, signlessType, j);3680 }3681 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);3682 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);3683 3684 // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to3685 // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))3686 mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, bitSize, shift);3687 3688 mlir::Value lArgs[2]{i, diff};3689 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);3690 3691 mlir::Value rArgs[2]{j, shift};3692 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);3693 mlir::Value result = mlir::arith::OrIOp::create(builder, loc, lft, rgt);3694 if (resultType.isUnsignedInteger())3695 return builder.createConvert(loc, resultType, result);3696 return result;3697}3698 3699// EOSHIFT3700fir::ExtendedValue3701IntrinsicLibrary::genEoshift(mlir::Type resultType,3702 llvm::ArrayRef<fir::ExtendedValue> args) {3703 assert(args.size() == 4);3704 3705 // Handle required ARRAY argument3706 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);3707 mlir::Value array = fir::getBase(arrayBox);3708 unsigned arrayRank = arrayBox.rank();3709 3710 // Create mutable fir.box to be passed to the runtime for the result.3711 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);3712 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(3713 builder, loc, resultArrayType, {},3714 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});3715 mlir::Value resultIrBox =3716 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);3717 3718 // Handle optional BOUNDARY argument3719 mlir::Value boundary =3720 isStaticallyAbsent(args[2])3721 ? fir::AbsentOp::create(builder, loc,3722 fir::BoxType::get(builder.getNoneType()))3723 : builder.createBox(loc, args[2]);3724 3725 if (arrayRank == 1) {3726 // Vector case3727 // Handle required SHIFT argument as a scalar3728 const mlir::Value *shiftAddr = args[1].getUnboxed();3729 assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");3730 auto shift = fir::LoadOp::create(builder, loc, *shiftAddr);3731 fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,3732 boundary);3733 } else {3734 // Non-vector case3735 // Handle required SHIFT argument as an array3736 mlir::Value shift = builder.createBox(loc, args[1]);3737 3738 // Handle optional DIM argument3739 mlir::Value dim =3740 isStaticallyAbsent(args[3])3741 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)3742 : fir::getBase(args[3]);3743 fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,3744 dim);3745 }3746 return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT");3747}3748 3749// EXECUTE_COMMAND_LINE3750void IntrinsicLibrary::genExecuteCommandLine(3751 llvm::ArrayRef<fir::ExtendedValue> args) {3752 assert(args.size() == 5);3753 3754 mlir::Value command = fir::getBase(args[0]);3755 // Optional arguments: wait, exitstat, cmdstat, cmdmsg.3756 const fir::ExtendedValue &wait = args[1];3757 const fir::ExtendedValue &exitstat = args[2];3758 const fir::ExtendedValue &cmdstat = args[3];3759 const fir::ExtendedValue &cmdmsg = args[4];3760 3761 if (!command)3762 fir::emitFatalError(loc, "expected COMMAND parameter");3763 3764 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());3765 3766 mlir::Value waitBool;3767 if (isStaticallyAbsent(wait)) {3768 waitBool = builder.createBool(loc, true);3769 } else {3770 mlir::Type i1Ty = builder.getI1Type();3771 mlir::Value waitAddr = fir::getBase(wait);3772 mlir::Value waitIsPresentAtRuntime =3773 builder.genIsNotNullAddr(loc, waitAddr);3774 waitBool =3775 builder3776 .genIfOp(loc, {i1Ty}, waitIsPresentAtRuntime,3777 /*withElseRegion=*/true)3778 .genThen([&]() {3779 auto waitLoad = fir::LoadOp::create(builder, loc, waitAddr);3780 mlir::Value cast = builder.createConvert(loc, i1Ty, waitLoad);3781 fir::ResultOp::create(builder, loc, cast);3782 })3783 .genElse([&]() {3784 mlir::Value trueVal = builder.createBool(loc, true);3785 fir::ResultOp::create(builder, loc, trueVal);3786 })3787 .getResults()[0];3788 }3789 3790 mlir::Value exitstatBox =3791 isStaticallyPresent(exitstat)3792 ? fir::getBase(exitstat)3793 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();3794 mlir::Value cmdstatBox =3795 isStaticallyPresent(cmdstat)3796 ? fir::getBase(cmdstat)3797 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();3798 mlir::Value cmdmsgBox =3799 isStaticallyPresent(cmdmsg)3800 ? fir::getBase(cmdmsg)3801 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();3802 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,3803 exitstatBox, cmdstatBox, cmdmsgBox);3804}3805 3806// ETIME3807fir::ExtendedValue3808IntrinsicLibrary::genEtime(std::optional<mlir::Type> resultType,3809 llvm::ArrayRef<fir::ExtendedValue> args) {3810 assert((args.size() == 2 && !resultType.has_value()) ||3811 (args.size() == 1 && resultType.has_value()));3812 3813 mlir::Value values = fir::getBase(args[0]);3814 if (resultType.has_value()) {3815 // function form3816 if (!values)3817 fir::emitFatalError(loc, "expected VALUES parameter");3818 3819 auto timeAddr = builder.createTemporary(loc, *resultType);3820 auto timeBox = builder.createBox(loc, timeAddr);3821 fir::runtime::genEtime(builder, loc, values, timeBox);3822 return fir::LoadOp::create(builder, loc, timeAddr);3823 } else {3824 // subroutine form3825 mlir::Value time = fir::getBase(args[1]);3826 if (!values)3827 fir::emitFatalError(loc, "expected VALUES parameter");3828 if (!time)3829 fir::emitFatalError(loc, "expected TIME parameter");3830 3831 fir::runtime::genEtime(builder, loc, values, time);3832 return {};3833 }3834 return {};3835}3836 3837// EXIT3838void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {3839 assert(args.size() == 1);3840 3841 mlir::Value status =3842 isStaticallyAbsent(args[0])3843 ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),3844 EXIT_SUCCESS)3845 : fir::getBase(args[0]);3846 3847 assert(status.getType() == builder.getDefaultIntegerType() &&3848 "STATUS parameter must be an INTEGER of default kind");3849 3850 fir::runtime::genExit(builder, loc, status);3851}3852 3853// EXPONENT3854mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,3855 llvm::ArrayRef<mlir::Value> args) {3856 assert(args.size() == 1);3857 3858 return builder.createConvert(3859 loc, resultType,3860 fir::runtime::genExponent(builder, loc, resultType,3861 fir::getBase(args[0])));3862}3863 3864// EXTENDS_TYPE_OF3865fir::ExtendedValue3866IntrinsicLibrary::genExtendsTypeOf(mlir::Type resultType,3867 llvm::ArrayRef<fir::ExtendedValue> args) {3868 assert(args.size() == 2);3869 3870 return builder.createConvert(3871 loc, resultType,3872 fir::runtime::genExtendsTypeOf(builder, loc, fir::getBase(args[0]),3873 fir::getBase(args[1])));3874}3875 3876// FINDLOC3877fir::ExtendedValue3878IntrinsicLibrary::genFindloc(mlir::Type resultType,3879 llvm::ArrayRef<fir::ExtendedValue> args) {3880 assert(args.size() == 6);3881 3882 // Handle required array argument3883 mlir::Value array = builder.createBox(loc, args[0]);3884 unsigned rank = fir::BoxValue(array).rank();3885 assert(rank >= 1);3886 3887 // Handle required value argument3888 mlir::Value val = builder.createBox(loc, args[1]);3889 3890 // Check if dim argument is present3891 bool absentDim = isStaticallyAbsent(args[2]);3892 3893 // Handle optional mask argument3894 auto mask = isStaticallyAbsent(args[3])3895 ? fir::AbsentOp::create(3896 builder, loc, fir::BoxType::get(builder.getI1Type()))3897 : builder.createBox(loc, args[3]);3898 3899 // Handle optional kind argument3900 auto kind = isStaticallyAbsent(args[4])3901 ? builder.createIntegerConstant(3902 loc, builder.getIndexType(),3903 builder.getKindMap().defaultIntegerKind())3904 : fir::getBase(args[4]);3905 3906 // Handle optional back argument3907 auto back = isStaticallyAbsent(args[5]) ? builder.createBool(loc, false)3908 : fir::getBase(args[5]);3909 3910 if (!absentDim && rank == 1) {3911 // If dim argument is present and the array is rank 1, then the result is3912 // a scalar (since the the result is rank-1 or 0).3913 // Therefore, we use a scalar result descriptor with FindlocDim().3914 // Create mutable fir.box to be passed to the runtime for the result.3915 fir::MutableBoxValue resultMutableBox =3916 fir::factory::createTempMutableBox(builder, loc, resultType);3917 mlir::Value resultIrBox =3918 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);3919 mlir::Value dim = fir::getBase(args[2]);3920 3921 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,3922 mask, kind, back);3923 // Handle cleanup of allocatable result descriptor and return3924 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");3925 }3926 3927 // The result will be an array. Create mutable fir.box to be passed to the3928 // runtime for the result.3929 mlir::Type resultArrayType =3930 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);3931 fir::MutableBoxValue resultMutableBox =3932 fir::factory::createTempMutableBox(builder, loc, resultArrayType);3933 mlir::Value resultIrBox =3934 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);3935 3936 if (absentDim) {3937 fir::runtime::genFindloc(builder, loc, resultIrBox, array, val, mask, kind,3938 back);3939 } else {3940 mlir::Value dim = fir::getBase(args[2]);3941 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,3942 mask, kind, back);3943 }3944 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");3945}3946 3947// FLOOR3948mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,3949 llvm::ArrayRef<mlir::Value> args) {3950 // Optional KIND argument.3951 assert(args.size() >= 1);3952 mlir::Value arg = args[0];3953 // Use LLVM floor that returns real.3954 mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});3955 return builder.createConvert(loc, resultType, floor);3956}3957 3958// FLUSH3959void IntrinsicLibrary::genFlush(llvm::ArrayRef<fir::ExtendedValue> args) {3960 assert(args.size() == 1);3961 3962 mlir::Value unit;3963 if (isStaticallyAbsent(args[0]))3964 // Give a sentinal value of `-1` on the `()` case.3965 unit = builder.createIntegerConstant(loc, builder.getI32Type(), -1);3966 else {3967 unit = fir::getBase(args[0]);3968 if (isOptional(unit)) {3969 mlir::Value isPresent =3970 fir::IsPresentOp::create(builder, loc, builder.getI1Type(), unit);3971 unit = builder3972 .genIfOp(loc, builder.getI32Type(), isPresent,3973 /*withElseRegion=*/true)3974 .genThen([&]() {3975 mlir::Value loaded = fir::LoadOp::create(builder, loc, unit);3976 fir::ResultOp::create(builder, loc, loaded);3977 })3978 .genElse([&]() {3979 mlir::Value negOne = builder.createIntegerConstant(3980 loc, builder.getI32Type(), -1);3981 fir::ResultOp::create(builder, loc, negOne);3982 })3983 .getResults()[0];3984 } else {3985 unit = fir::LoadOp::create(builder, loc, unit);3986 }3987 }3988 3989 fir::runtime::genFlush(builder, loc, unit);3990}3991 3992// FRACTION3993mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,3994 llvm::ArrayRef<mlir::Value> args) {3995 assert(args.size() == 1);3996 3997 return builder.createConvert(3998 loc, resultType,3999 fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));4000}4001 4002void IntrinsicLibrary::genFree(llvm::ArrayRef<fir::ExtendedValue> args) {4003 assert(args.size() == 1);4004 4005 fir::runtime::genFree(builder, loc, fir::getBase(args[0]));4006}4007 4008// FSEEK4009fir::ExtendedValue4010IntrinsicLibrary::genFseek(std::optional<mlir::Type> resultType,4011 llvm::ArrayRef<fir::ExtendedValue> args) {4012 assert((args.size() == 4 && !resultType.has_value()) ||4013 (args.size() == 3 && resultType.has_value()));4014 mlir::Value unit = fir::getBase(args[0]);4015 mlir::Value offset = fir::getBase(args[1]);4016 mlir::Value whence = fir::getBase(args[2]);4017 if (!unit)4018 fir::emitFatalError(loc, "expected UNIT argument");4019 if (!offset)4020 fir::emitFatalError(loc, "expected OFFSET argument");4021 if (!whence)4022 fir::emitFatalError(loc, "expected WHENCE argument");4023 mlir::Value statusValue =4024 fir::runtime::genFseek(builder, loc, unit, offset, whence);4025 if (resultType.has_value()) { // function4026 return builder.createConvert(loc, *resultType, statusValue);4027 } else { // subroutine4028 const fir::ExtendedValue &statusVar = args[3];4029 if (!isStaticallyAbsent(statusVar)) {4030 mlir::Value statusAddr = fir::getBase(statusVar);4031 mlir::Value statusIsPresentAtRuntime =4032 builder.genIsNotNullAddr(loc, statusAddr);4033 builder.genIfThen(loc, statusIsPresentAtRuntime)4034 .genThen([&]() {4035 builder.createStoreWithConvert(loc, statusValue, statusAddr);4036 })4037 .end();4038 }4039 return {};4040 }4041}4042 4043// FTELL4044fir::ExtendedValue4045IntrinsicLibrary::genFtell(std::optional<mlir::Type> resultType,4046 llvm::ArrayRef<fir::ExtendedValue> args) {4047 assert((args.size() == 2 && !resultType.has_value()) ||4048 (args.size() == 1 && resultType.has_value()));4049 mlir::Value unit = fir::getBase(args[0]);4050 if (!unit)4051 fir::emitFatalError(loc, "expected UNIT argument");4052 mlir::Value offsetValue = fir::runtime::genFtell(builder, loc, unit);4053 if (resultType.has_value()) { // function4054 return offsetValue;4055 } else { // subroutine4056 const fir::ExtendedValue &offsetVar = args[1];4057 if (!isStaticallyAbsent(offsetVar)) {4058 mlir::Value offsetAddr = fir::getBase(offsetVar);4059 mlir::Value offsetIsPresentAtRuntime =4060 builder.genIsNotNullAddr(loc, offsetAddr);4061 builder.genIfThen(loc, offsetIsPresentAtRuntime)4062 .genThen([&]() {4063 builder.createStoreWithConvert(loc, offsetValue, offsetAddr);4064 })4065 .end();4066 }4067 return {};4068 }4069}4070 4071// GET_TEAM4072mlir::Value IntrinsicLibrary::genGetTeam(mlir::Type resultType,4073 llvm::ArrayRef<mlir::Value> args) {4074 converter->checkCoarrayEnabled();4075 assert(args.size() == 1);4076 return mif::GetTeamOp::create(builder, loc, fir::BoxType::get(resultType),4077 /*level*/ args[0]);4078}4079 4080// GETCWD4081fir::ExtendedValue4082IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,4083 llvm::ArrayRef<fir::ExtendedValue> args) {4084 assert((args.size() == 1 && resultType.has_value()) ||4085 (args.size() >= 1 && !resultType.has_value()));4086 4087 mlir::Value cwd = fir::getBase(args[0]);4088 mlir::Value statusValue = fir::runtime::genGetCwd(builder, loc, cwd);4089 4090 if (resultType.has_value()) {4091 // Function form, return status.4092 return statusValue;4093 } else {4094 // Subroutine form, store status and return none.4095 const fir::ExtendedValue &status = args[1];4096 if (!isStaticallyAbsent(status)) {4097 mlir::Value statusAddr = fir::getBase(status);4098 mlir::Value statusIsPresentAtRuntime =4099 builder.genIsNotNullAddr(loc, statusAddr);4100 builder.genIfThen(loc, statusIsPresentAtRuntime)4101 .genThen([&]() {4102 builder.createStoreWithConvert(loc, statusValue, statusAddr);4103 })4104 .end();4105 }4106 }4107 4108 return {};4109}4110 4111// GET_COMMAND4112void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {4113 assert(args.size() == 4);4114 const fir::ExtendedValue &command = args[0];4115 const fir::ExtendedValue &length = args[1];4116 const fir::ExtendedValue &status = args[2];4117 const fir::ExtendedValue &errmsg = args[3];4118 4119 // If none of the optional parameters are present, do nothing.4120 if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&4121 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))4122 return;4123 4124 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());4125 mlir::Value commandBox =4126 isStaticallyPresent(command)4127 ? fir::getBase(command)4128 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4129 mlir::Value lenBox =4130 isStaticallyPresent(length)4131 ? fir::getBase(length)4132 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4133 mlir::Value errBox =4134 isStaticallyPresent(errmsg)4135 ? fir::getBase(errmsg)4136 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4137 mlir::Value stat =4138 fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);4139 if (isStaticallyPresent(status)) {4140 mlir::Value statAddr = fir::getBase(status);4141 mlir::Value statIsPresentAtRuntime =4142 builder.genIsNotNullAddr(loc, statAddr);4143 builder.genIfThen(loc, statIsPresentAtRuntime)4144 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })4145 .end();4146 }4147}4148 4149// GETGID4150mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType,4151 llvm::ArrayRef<mlir::Value> args) {4152 assert(args.size() == 0 && "getgid takes no input");4153 return builder.createConvert(loc, resultType,4154 fir::runtime::genGetGID(builder, loc));4155}4156 4157// GETPID4158mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,4159 llvm::ArrayRef<mlir::Value> args) {4160 assert(args.size() == 0 && "getpid takes no input");4161 return builder.createConvert(loc, resultType,4162 fir::runtime::genGetPID(builder, loc));4163}4164 4165// GETUID4166mlir::Value IntrinsicLibrary::genGetUID(mlir::Type resultType,4167 llvm::ArrayRef<mlir::Value> args) {4168 assert(args.size() == 0 && "getgid takes no input");4169 return builder.createConvert(loc, resultType,4170 fir::runtime::genGetUID(builder, loc));4171}4172 4173// GET_COMMAND_ARGUMENT4174void IntrinsicLibrary::genGetCommandArgument(4175 llvm::ArrayRef<fir::ExtendedValue> args) {4176 assert(args.size() == 5);4177 mlir::Value number = fir::getBase(args[0]);4178 const fir::ExtendedValue &value = args[1];4179 const fir::ExtendedValue &length = args[2];4180 const fir::ExtendedValue &status = args[3];4181 const fir::ExtendedValue &errmsg = args[4];4182 4183 if (!number)4184 fir::emitFatalError(loc, "expected NUMBER parameter");4185 4186 // If none of the optional parameters are present, do nothing.4187 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&4188 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))4189 return;4190 4191 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());4192 mlir::Value valBox =4193 isStaticallyPresent(value)4194 ? fir::getBase(value)4195 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4196 mlir::Value lenBox =4197 isStaticallyPresent(length)4198 ? fir::getBase(length)4199 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4200 mlir::Value errBox =4201 isStaticallyPresent(errmsg)4202 ? fir::getBase(errmsg)4203 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4204 mlir::Value stat = fir::runtime::genGetCommandArgument(4205 builder, loc, number, valBox, lenBox, errBox);4206 if (isStaticallyPresent(status)) {4207 mlir::Value statAddr = fir::getBase(status);4208 mlir::Value statIsPresentAtRuntime =4209 builder.genIsNotNullAddr(loc, statAddr);4210 builder.genIfThen(loc, statIsPresentAtRuntime)4211 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })4212 .end();4213 }4214}4215 4216// GET_ENVIRONMENT_VARIABLE4217void IntrinsicLibrary::genGetEnvironmentVariable(4218 llvm::ArrayRef<fir::ExtendedValue> args) {4219 assert(args.size() == 6);4220 mlir::Value name = fir::getBase(args[0]);4221 const fir::ExtendedValue &value = args[1];4222 const fir::ExtendedValue &length = args[2];4223 const fir::ExtendedValue &status = args[3];4224 const fir::ExtendedValue &trimName = args[4];4225 const fir::ExtendedValue &errmsg = args[5];4226 4227 if (!name)4228 fir::emitFatalError(loc, "expected NAME parameter");4229 4230 // If none of the optional parameters are present, do nothing.4231 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&4232 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))4233 return;4234 4235 // Handle optional TRIM_NAME argument4236 mlir::Value trim;4237 if (isStaticallyAbsent(trimName)) {4238 trim = builder.createBool(loc, true);4239 } else {4240 mlir::Type i1Ty = builder.getI1Type();4241 mlir::Value trimNameAddr = fir::getBase(trimName);4242 mlir::Value trimNameIsPresentAtRuntime =4243 builder.genIsNotNullAddr(loc, trimNameAddr);4244 trim = builder4245 .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,4246 /*withElseRegion=*/true)4247 .genThen([&]() {4248 auto trimLoad =4249 fir::LoadOp::create(builder, loc, trimNameAddr);4250 mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);4251 fir::ResultOp::create(builder, loc, cast);4252 })4253 .genElse([&]() {4254 mlir::Value trueVal = builder.createBool(loc, true);4255 fir::ResultOp::create(builder, loc, trueVal);4256 })4257 .getResults()[0];4258 }4259 4260 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());4261 mlir::Value valBox =4262 isStaticallyPresent(value)4263 ? fir::getBase(value)4264 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4265 mlir::Value lenBox =4266 isStaticallyPresent(length)4267 ? fir::getBase(length)4268 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4269 mlir::Value errBox =4270 isStaticallyPresent(errmsg)4271 ? fir::getBase(errmsg)4272 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();4273 mlir::Value stat = fir::runtime::genGetEnvVariable(builder, loc, name, valBox,4274 lenBox, trim, errBox);4275 if (isStaticallyPresent(status)) {4276 mlir::Value statAddr = fir::getBase(status);4277 mlir::Value statIsPresentAtRuntime =4278 builder.genIsNotNullAddr(loc, statAddr);4279 builder.genIfThen(loc, statIsPresentAtRuntime)4280 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })4281 .end();4282 }4283}4284 4285// HOSTNM4286fir::ExtendedValue4287IntrinsicLibrary::genHostnm(std::optional<mlir::Type> resultType,4288 llvm::ArrayRef<fir::ExtendedValue> args) {4289 assert((args.size() == 1 && resultType.has_value()) ||4290 (args.size() >= 1 && !resultType.has_value()));4291 4292 mlir::Value res = fir::getBase(args[0]);4293 mlir::Value statusValue = fir::runtime::genHostnm(builder, loc, res);4294 4295 if (resultType.has_value()) {4296 // Function form, return status.4297 return builder.createConvert(loc, *resultType, statusValue);4298 }4299 4300 // Subroutine form, store status and return none.4301 const fir::ExtendedValue &status = args[1];4302 if (!isStaticallyAbsent(status)) {4303 mlir::Value statusAddr = fir::getBase(status);4304 mlir::Value statusIsPresentAtRuntime =4305 builder.genIsNotNullAddr(loc, statusAddr);4306 builder.genIfThen(loc, statusIsPresentAtRuntime)4307 .genThen([&]() {4308 builder.createStoreWithConvert(loc, statusValue, statusAddr);4309 })4310 .end();4311 }4312 4313 return {};4314}4315 4316/// Process calls to Maxval, Minval, Product, Sum intrinsic functions that4317/// take a DIM argument.4318template <typename FD>4319static fir::MutableBoxValue4320genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,4321 mlir::Location loc, mlir::Value array, fir::ExtendedValue dimArg,4322 mlir::Value mask, int rank) {4323 4324 // Create mutable fir.box to be passed to the runtime for the result.4325 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);4326 fir::MutableBoxValue resultMutableBox =4327 fir::factory::createTempMutableBox(builder, loc, resultArrayType);4328 mlir::Value resultIrBox =4329 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);4330 4331 mlir::Value dim =4332 isStaticallyAbsent(dimArg)4333 ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)4334 : fir::getBase(dimArg);4335 funcDim(builder, loc, resultIrBox, array, dim, mask);4336 4337 return resultMutableBox;4338}4339 4340/// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions4341template <typename FN, typename FD>4342fir::ExtendedValue4343IntrinsicLibrary::genReduction(FN func, FD funcDim, llvm::StringRef errMsg,4344 mlir::Type resultType,4345 llvm::ArrayRef<fir::ExtendedValue> args) {4346 4347 assert(args.size() == 3);4348 4349 // Handle required array argument4350 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);4351 mlir::Value array = fir::getBase(arryTmp);4352 int rank = arryTmp.rank();4353 assert(rank >= 1);4354 4355 // Handle optional mask argument4356 auto mask = isStaticallyAbsent(args[2])4357 ? fir::AbsentOp::create(4358 builder, loc, fir::BoxType::get(builder.getI1Type()))4359 : builder.createBox(loc, args[2]);4360 4361 bool absentDim = isStaticallyAbsent(args[1]);4362 4363 // We call the type specific versions because the result is scalar4364 // in the case below.4365 if (absentDim || rank == 1) {4366 mlir::Type ty = array.getType();4367 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);4368 auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType();4369 if (fir::isa_complex(eleTy)) {4370 mlir::Value result = builder.createTemporary(loc, eleTy);4371 func(builder, loc, array, mask, result);4372 return fir::LoadOp::create(builder, loc, result);4373 }4374 auto resultBox = fir::AbsentOp::create(4375 builder, loc, fir::BoxType::get(builder.getI1Type()));4376 return func(builder, loc, array, mask, resultBox);4377 }4378 // Handle Product/Sum cases that have an array result.4379 auto resultMutableBox =4380 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);4381 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);4382}4383 4384// IALL4385fir::ExtendedValue4386IntrinsicLibrary::genIall(mlir::Type resultType,4387 llvm::ArrayRef<fir::ExtendedValue> args) {4388 return genReduction(fir::runtime::genIAll, fir::runtime::genIAllDim, "IALL",4389 resultType, args);4390}4391 4392// IAND4393mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,4394 llvm::ArrayRef<mlir::Value> args) {4395 assert(args.size() == 2);4396 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],4397 args[1]);4398}4399 4400// IANY4401fir::ExtendedValue4402IntrinsicLibrary::genIany(mlir::Type resultType,4403 llvm::ArrayRef<fir::ExtendedValue> args) {4404 return genReduction(fir::runtime::genIAny, fir::runtime::genIAnyDim, "IANY",4405 resultType, args);4406}4407 4408// IBCLR4409mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,4410 llvm::ArrayRef<mlir::Value> args) {4411 // A conformant IBCLR(I,POS) call satisfies:4412 // POS >= 04413 // POS < BIT_SIZE(I)4414 // Return: I & (!(1 << POS))4415 assert(args.size() == 2);4416 mlir::Type signlessType = mlir::IntegerType::get(4417 builder.getContext(), resultType.getIntOrFloatBitWidth(),4418 mlir::IntegerType::SignednessSemantics::Signless);4419 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);4420 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);4421 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);4422 mlir::Value bit = mlir::arith::ShLIOp::create(builder, loc, one, pos);4423 mlir::Value mask = mlir::arith::XOrIOp::create(builder, loc, ones, bit);4424 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],4425 mask);4426}4427 4428// IBITS4429mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,4430 llvm::ArrayRef<mlir::Value> args) {4431 // A conformant IBITS(I,POS,LEN) call satisfies:4432 // POS >= 04433 // LEN >= 04434 // POS + LEN <= BIT_SIZE(I)4435 // Return: LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))4436 // For a conformant call, implementing (I >> POS) with a signed or an4437 // unsigned shift produces the same result. For a nonconformant call,4438 // the two choices may produce different results.4439 assert(args.size() == 3);4440 mlir::Type signlessType = mlir::IntegerType::get(4441 builder.getContext(), resultType.getIntOrFloatBitWidth(),4442 mlir::IntegerType::SignednessSemantics::Signless);4443 mlir::Value word = args[0];4444 if (word.getType().isUnsignedInteger())4445 word = builder.createConvert(loc, signlessType, word);4446 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);4447 mlir::Value len = builder.createConvert(loc, signlessType, args[2]);4448 mlir::Value bitSize = builder.createIntegerConstant(4449 loc, signlessType, mlir::cast<mlir::IntegerType>(resultType).getWidth());4450 mlir::Value shiftCount =4451 mlir::arith::SubIOp::create(builder, loc, bitSize, len);4452 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);4453 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);4454 mlir::Value mask =4455 mlir::arith::ShRUIOp::create(builder, loc, ones, shiftCount);4456 mlir::Value res1 = builder.createUnsigned<mlir::arith::ShRSIOp>(4457 loc, signlessType, word, pos);4458 mlir::Value res2 = mlir::arith::AndIOp::create(builder, loc, res1, mask);4459 mlir::Value lenIsZero = mlir::arith::CmpIOp::create(4460 builder, loc, mlir::arith::CmpIPredicate::eq, len, zero);4461 mlir::Value result =4462 mlir::arith::SelectOp::create(builder, loc, lenIsZero, zero, res2);4463 if (resultType.isUnsignedInteger())4464 return builder.createConvert(loc, resultType, result);4465 return result;4466}4467 4468// IBSET4469mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,4470 llvm::ArrayRef<mlir::Value> args) {4471 // A conformant IBSET(I,POS) call satisfies:4472 // POS >= 04473 // POS < BIT_SIZE(I)4474 // Return: I | (1 << POS)4475 assert(args.size() == 2);4476 mlir::Type signlessType = mlir::IntegerType::get(4477 builder.getContext(), resultType.getIntOrFloatBitWidth(),4478 mlir::IntegerType::SignednessSemantics::Signless);4479 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);4480 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);4481 mlir::Value mask = mlir::arith::ShLIOp::create(builder, loc, one, pos);4482 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],4483 mask);4484}4485 4486// ICHAR4487fir::ExtendedValue4488IntrinsicLibrary::genIchar(mlir::Type resultType,4489 llvm::ArrayRef<fir::ExtendedValue> args) {4490 // There can be an optional kind in second argument.4491 assert(args.size() == 2);4492 const fir::CharBoxValue *charBox = args[0].getCharBox();4493 if (!charBox)4494 llvm::report_fatal_error("expected character scalar");4495 4496 fir::factory::CharacterExprHelper helper{builder, loc};4497 mlir::Value buffer = charBox->getBuffer();4498 mlir::Type bufferTy = buffer.getType();4499 mlir::Value charVal;4500 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(bufferTy)) {4501 assert(charTy.singleton());4502 charVal = buffer;4503 } else {4504 // Character is in memory, cast to fir.ref<char> and load.4505 mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);4506 if (!ty)4507 llvm::report_fatal_error("expected memory type");4508 // The length of in the character type may be unknown. Casting4509 // to a singleton ref is required before loading.4510 fir::CharacterType eleType = helper.getCharacterType(ty);4511 fir::CharacterType charType =4512 fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);4513 mlir::Type toTy = builder.getRefType(charType);4514 mlir::Value cast = builder.createConvert(loc, toTy, buffer);4515 charVal = fir::LoadOp::create(builder, loc, cast);4516 }4517 LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");4518 auto code = helper.extractCodeFromSingleton(charVal);4519 if (code.getType() == resultType)4520 return code;4521 return mlir::arith::ExtUIOp::create(builder, loc, resultType, code);4522}4523 4524// llvm floating point class intrinsic test values4525// 0 Signaling NaN4526// 1 Quiet NaN4527// 2 Negative infinity4528// 3 Negative normal4529// 4 Negative subnormal4530// 5 Negative zero4531// 6 Positive zero4532// 7 Positive subnormal4533// 8 Positive normal4534// 9 Positive infinity4535static constexpr int finiteTest = 0b0111111000;4536static constexpr int infiniteTest = 0b1000000100;4537static constexpr int nanTest = 0b0000000011;4538static constexpr int negativeTest = 0b0000111100;4539static constexpr int normalTest = 0b0101101000;4540static constexpr int positiveTest = 0b1111000000;4541static constexpr int snanTest = 0b0000000001;4542static constexpr int subnormalTest = 0b0010010000;4543static constexpr int zeroTest = 0b0001100000;4544 4545mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,4546 llvm::ArrayRef<mlir::Value> args,4547 int fpclass) {4548 assert(args.size() == 1);4549 mlir::Type i1Ty = builder.getI1Type();4550 mlir::Value isfpclass =4551 mlir::LLVM::IsFPClass::create(builder, loc, i1Ty, args[0], fpclass);4552 return builder.createConvert(loc, resultType, isfpclass);4553}4554 4555// Generate a quiet NaN of a given floating point type.4556mlir::Value IntrinsicLibrary::genQNan(mlir::Type resultType) {4557 return genIeeeValue(resultType, builder.createIntegerConstant(4558 loc, builder.getIntegerType(8),4559 _FORTRAN_RUNTIME_IEEE_QUIET_NAN));4560}4561 4562// Generate code to raise \p excepts if \p cond is absent, or present and true.4563void IntrinsicLibrary::genRaiseExcept(int excepts, mlir::Value cond) {4564 fir::IfOp ifOp;4565 if (cond) {4566 ifOp = fir::IfOp::create(builder, loc, cond, /*withElseRegion=*/false);4567 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());4568 }4569 mlir::Type i32Ty = builder.getIntegerType(32);4570 fir::runtime::genFeraiseexcept(4571 builder, loc,4572 fir::runtime::genMapExcept(4573 builder, loc, builder.createIntegerConstant(loc, i32Ty, excepts)));4574 if (cond)4575 builder.setInsertionPointAfter(ifOp);4576}4577 4578// Return a reference to the contents of a derived type with one field.4579// Also return the field type.4580static std::pair<mlir::Value, mlir::Type>4581getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec,4582 unsigned index = 0) {4583 auto recType =4584 mlir::dyn_cast<fir::RecordType>(fir::unwrapPassByRefType(rec.getType()));4585 assert(index < recType.getTypeList().size() && "not enough components");4586 auto [fieldName, fieldTy] = recType.getTypeList()[index];4587 mlir::Value field = fir::FieldIndexOp::create(4588 builder, loc, fir::FieldType::get(recType.getContext()), fieldName,4589 recType, fir::getTypeParams(rec));4590 return {fir::CoordinateOp::create(builder, loc, builder.getRefType(fieldTy),4591 rec, field),4592 fieldTy};4593}4594 4595// IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)4596// IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)4597template <mlir::arith::CmpIPredicate pred>4598mlir::Value4599IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,4600 llvm::ArrayRef<mlir::Value> args) {4601 assert(args.size() == 2);4602 auto [leftRef, fieldTy] = getFieldRef(builder, loc, args[0]);4603 auto [rightRef, ignore] = getFieldRef(builder, loc, args[1]);4604 mlir::Value left = fir::LoadOp::create(builder, loc, fieldTy, leftRef);4605 mlir::Value right = fir::LoadOp::create(builder, loc, fieldTy, rightRef);4606 return mlir::arith::CmpIOp::create(builder, loc, pred, left, right);4607}4608 4609// IEEE_CLASS4610mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,4611 llvm::ArrayRef<mlir::Value> args) {4612 // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via4613 // a table lookup on an index built from 5 values derived from X.4614 // In indexing order, the values are:4615 //4616 // [s] sign bit4617 // [e] exponent != 04618 // [m] exponent == 1..1 (max exponent)4619 // [l] low-order significand != 04620 // [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit)4621 //4622 // kind=10 values have an explicit high-order integer significand bit,4623 // whereas this bit is implicit for other kinds. This requires using a 6-bit4624 // index into a 64-slot table for kind=10 argument classification queries4625 // vs. a 5-bit index into a 32-slot table for other argument kind queries.4626 // The instruction sequence is the same for the two cases.4627 //4628 // Placing the [l] and [h] significand bits in "swapped" order rather than4629 // "natural" order enables more efficient generated code.4630 4631 assert(args.size() == 1);4632 mlir::Value realVal = args[0];4633 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());4634 const unsigned intWidth = realType.getWidth();4635 mlir::Type intType = builder.getIntegerType(intWidth);4636 mlir::Value intVal =4637 mlir::arith::BitcastOp::create(builder, loc, intType, realVal);4638 llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable);4639 uint64_t highSignificandSize = (realType.getWidth() == 80) + 1;4640 4641 // Get masks and shift counts.4642 mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask;4643 auto createIntegerConstant = [&](uint64_t k) {4644 return builder.createIntegerConstant(loc, intType, k);4645 };4646 auto createIntegerConstantAPI = [&](const llvm::APInt &apInt) {4647 return mlir::arith::ConstantOp::create(4648 builder, loc, intType, builder.getIntegerAttr(intType, apInt));4649 };4650 auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize,4651 uint64_t significandSize,4652 bool hasExplicitBit = false) {4653 assert(1 + exponentSize + significandSize == totalSize &&4654 "invalid floating point fields");4655 uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1;4656 signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4);4657 highSignificandShift = createIntegerConstant(lowSignificandSize);4658 llvm::APInt exponentMaskAPI =4659 llvm::APInt::getBitsSet(intWidth, /*lo=*/significandSize,4660 /*hi=*/significandSize + exponentSize);4661 exponentMask = createIntegerConstantAPI(exponentMaskAPI);4662 llvm::APInt lowSignificandMaskAPI =4663 llvm::APInt::getLowBitsSet(intWidth, lowSignificandSize);4664 lowSignificandMask = createIntegerConstantAPI(lowSignificandMaskAPI);4665 };4666 switch (realType.getWidth()) {4667 case 16:4668 if (realType.isF16()) {4669 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits4670 getMasksAndShifts(16, 5, 10);4671 } else {4672 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits4673 getMasksAndShifts(16, 8, 7);4674 }4675 break;4676 case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits4677 getMasksAndShifts(32, 8, 23);4678 break;4679 case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits4680 getMasksAndShifts(64, 11, 52);4681 break;4682 case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits4683 getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true);4684 tableName = RTNAME_STRING(IeeeClassTable_10);4685 break;4686 case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits4687 getMasksAndShifts(128, 15, 112);4688 break;4689 default:4690 llvm_unreachable("unknown real type");4691 }4692 4693 // [s] sign bit4694 int pos = 3 + highSignificandSize;4695 mlir::Value index = mlir::arith::AndIOp::create(4696 builder, loc,4697 mlir::arith::ShRUIOp::create(builder, loc, intVal, signShift),4698 createIntegerConstant(1ULL << pos));4699 4700 // [e] exponent != 04701 mlir::Value exponent =4702 mlir::arith::AndIOp::create(builder, loc, intVal, exponentMask);4703 mlir::Value zero = createIntegerConstant(0);4704 index = mlir::arith::OrIOp::create(4705 builder, loc, index,4706 mlir::arith::SelectOp::create(4707 builder, loc,4708 mlir::arith::CmpIOp::create(4709 builder, loc, mlir::arith::CmpIPredicate::ne, exponent, zero),4710 createIntegerConstant(1ULL << --pos), zero));4711 4712 // [m] exponent == 1..1 (max exponent)4713 index = mlir::arith::OrIOp::create(4714 builder, loc, index,4715 mlir::arith::SelectOp::create(4716 builder, loc,4717 mlir::arith::CmpIOp::create(builder, loc,4718 mlir::arith::CmpIPredicate::eq, exponent,4719 exponentMask),4720 createIntegerConstant(1ULL << --pos), zero));4721 4722 // [l] low-order significand != 04723 index = mlir::arith::OrIOp::create(4724 builder, loc, index,4725 mlir::arith::SelectOp::create(4726 builder, loc,4727 mlir::arith::CmpIOp::create(4728 builder, loc, mlir::arith::CmpIPredicate::ne,4729 mlir::arith::AndIOp::create(builder, loc, intVal,4730 lowSignificandMask),4731 zero),4732 createIntegerConstant(1ULL << --pos), zero));4733 4734 // [h] high-order significand (1 or 2 bits)4735 index = mlir::arith::OrIOp::create(4736 builder, loc, index,4737 mlir::arith::AndIOp::create(4738 builder, loc,4739 mlir::arith::ShRUIOp::create(builder, loc, intVal,4740 highSignificandShift),4741 createIntegerConstant((1 << highSignificandSize) - 1)));4742 4743 int tableSize = 1 << (4 + highSignificandSize);4744 mlir::Type int8Ty = builder.getIntegerType(8);4745 mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty);4746 if (!builder.getNamedGlobal(tableName)) {4747 llvm::SmallVector<mlir::Attribute, 64> values;4748 auto insert = [&](std::int8_t which) {4749 values.push_back(builder.getIntegerAttr(int8Ty, which));4750 };4751 // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0,4752 // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible4753 // combinations.4754 constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;4755 if (tableSize == 32) {4756 // s e m l h kinds 2,3,4,8,164757 // ===================================================================4758 /* 0 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);4759 /* 0 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4760 /* 0 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4761 /* 0 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4762 /* 0 0 1 0 0 */ insert(impossible);4763 /* 0 0 1 0 1 */ insert(impossible);4764 /* 0 0 1 1 0 */ insert(impossible);4765 /* 0 0 1 1 1 */ insert(impossible);4766 /* 0 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4767 /* 0 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4768 /* 0 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4769 /* 0 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4770 /* 0 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);4771 /* 0 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4772 /* 0 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);4773 /* 0 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4774 /* 1 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);4775 /* 1 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4776 /* 1 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4777 /* 1 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4778 /* 1 0 1 0 0 */ insert(impossible);4779 /* 1 0 1 0 1 */ insert(impossible);4780 /* 1 0 1 1 0 */ insert(impossible);4781 /* 1 0 1 1 1 */ insert(impossible);4782 /* 1 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4783 /* 1 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4784 /* 1 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4785 /* 1 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4786 /* 1 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);4787 /* 1 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4788 /* 1 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);4789 /* 1 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4790 } else {4791 // Unlike values of other kinds, kind=10 values can be "invalid", and4792 // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns.4793 // Runtime IO may print an invalid value as a NaN.4794 constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;4795 // s e m l h kind 104796 // ===================================================================4797 /* 0 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);4798 /* 0 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4799 /* 0 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4800 /* 0 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4801 /* 0 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4802 /* 0 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4803 /* 0 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4804 /* 0 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);4805 /* 0 0 1 0 00 */ insert(impossible);4806 /* 0 0 1 0 01 */ insert(impossible);4807 /* 0 0 1 0 10 */ insert(impossible);4808 /* 0 0 1 0 11 */ insert(impossible);4809 /* 0 0 1 1 00 */ insert(impossible);4810 /* 0 0 1 1 01 */ insert(impossible);4811 /* 0 0 1 1 10 */ insert(impossible);4812 /* 0 0 1 1 11 */ insert(impossible);4813 /* 0 1 0 0 00 */ insert(invalid);4814 /* 0 1 0 0 01 */ insert(invalid);4815 /* 0 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4816 /* 0 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4817 /* 0 1 0 1 00 */ insert(invalid);4818 /* 0 1 0 1 01 */ insert(invalid);4819 /* 0 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4820 /* 0 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);4821 /* 0 1 1 0 00 */ insert(invalid);4822 /* 0 1 1 0 01 */ insert(invalid);4823 /* 0 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);4824 /* 0 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4825 /* 0 1 1 1 00 */ insert(invalid);4826 /* 0 1 1 1 01 */ insert(invalid);4827 /* 0 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);4828 /* 0 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4829 /* 1 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);4830 /* 1 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4831 /* 1 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4832 /* 1 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4833 /* 1 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4834 /* 1 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4835 /* 1 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4836 /* 1 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);4837 /* 1 0 1 0 00 */ insert(impossible);4838 /* 1 0 1 0 01 */ insert(impossible);4839 /* 1 0 1 0 10 */ insert(impossible);4840 /* 1 0 1 0 11 */ insert(impossible);4841 /* 1 0 1 1 00 */ insert(impossible);4842 /* 1 0 1 1 01 */ insert(impossible);4843 /* 1 0 1 1 10 */ insert(impossible);4844 /* 1 0 1 1 11 */ insert(impossible);4845 /* 1 1 0 0 00 */ insert(invalid);4846 /* 1 1 0 0 01 */ insert(invalid);4847 /* 1 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4848 /* 1 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4849 /* 1 1 0 1 00 */ insert(invalid);4850 /* 1 1 0 1 01 */ insert(invalid);4851 /* 1 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4852 /* 1 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);4853 /* 1 1 1 0 00 */ insert(invalid);4854 /* 1 1 1 0 01 */ insert(invalid);4855 /* 1 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);4856 /* 1 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4857 /* 1 1 1 1 00 */ insert(invalid);4858 /* 1 1 1 1 01 */ insert(invalid);4859 /* 1 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);4860 /* 1 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);4861 }4862 builder.createGlobalConstant(4863 loc, tableTy, tableName, builder.createLinkOnceLinkage(),4864 mlir::DenseElementsAttr::get(4865 mlir::RankedTensorType::get(tableSize, int8Ty), values));4866 }4867 4868 return fir::CoordinateOp::create(4869 builder, loc, builder.getRefType(resultType),4870 fir::AddrOfOp::create(builder, loc, builder.getRefType(tableTy),4871 builder.getSymbolRefAttr(tableName)),4872 index);4873}4874 4875// IEEE_COPY_SIGN4876mlir::Value4877IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,4878 llvm::ArrayRef<mlir::Value> args) {4879 // Copy the sign of REAL arg Y to REAL arg X.4880 assert(args.size() == 2);4881 mlir::Value xRealVal = args[0];4882 mlir::Value yRealVal = args[1];4883 mlir::FloatType xRealType =4884 mlir::dyn_cast<mlir::FloatType>(xRealVal.getType());4885 mlir::FloatType yRealType =4886 mlir::dyn_cast<mlir::FloatType>(yRealVal.getType());4887 4888 if (yRealType == mlir::BFloat16Type::get(builder.getContext())) {4889 // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y.4890 // This conversion should always preserve the sign bit.4891 yRealVal = builder.createConvert(4892 loc, mlir::Float32Type::get(builder.getContext()), yRealVal);4893 yRealType = mlir::Float32Type::get(builder.getContext());4894 }4895 4896 // Args have the same type.4897 if (xRealType == yRealType)4898 return mlir::math::CopySignOp::create(builder, loc, xRealVal, yRealVal);4899 4900 // Args have different types.4901 mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth());4902 mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth());4903 mlir::Value xIntVal =4904 mlir::arith::BitcastOp::create(builder, loc, xIntType, xRealVal);4905 mlir::Value yIntVal =4906 mlir::arith::BitcastOp::create(builder, loc, yIntType, yRealVal);4907 mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0);4908 mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0);4909 mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1);4910 mlir::Value ySign = mlir::arith::ShRUIOp::create(4911 builder, loc, yIntVal,4912 builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1));4913 mlir::Value xAbs = mlir::arith::ShRUIOp::create(4914 builder, loc, mlir::arith::ShLIOp::create(builder, loc, xIntVal, xOne),4915 xOne);4916 mlir::Value xSign = mlir::arith::SelectOp::create(4917 builder, loc,4918 mlir::arith::CmpIOp::create(builder, loc, mlir::arith::CmpIPredicate::eq,4919 ySign, yZero),4920 xZero,4921 mlir::arith::ShLIOp::create(4922 builder, loc, xOne,4923 builder.createIntegerConstant(loc, xIntType,4924 xRealType.getWidth() - 1)));4925 return mlir::arith::BitcastOp::create(4926 builder, loc, xRealType,4927 mlir::arith::OrIOp::create(builder, loc, xAbs, xSign));4928}4929 4930// IEEE_GET_FLAG4931void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) {4932 assert(args.size() == 2);4933 // Set FLAG_VALUE=.TRUE. if the exception specified by FLAG is signaling.4934 mlir::Value flag = fir::getBase(args[0]);4935 mlir::Value flagValue = fir::getBase(args[1]);4936 mlir::Type resultTy =4937 mlir::dyn_cast<fir::ReferenceType>(flagValue.getType()).getEleTy();4938 mlir::Type i32Ty = builder.getIntegerType(32);4939 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);4940 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);4941 mlir::Value field = fir::LoadOp::create(builder, loc, fieldRef);4942 mlir::Value excepts = fir::runtime::genFetestexcept(4943 builder, loc,4944 fir::runtime::genMapExcept(4945 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, field)));4946 mlir::Value logicalResult = fir::ConvertOp::create(4947 builder, loc, resultTy,4948 mlir::arith::CmpIOp::create(builder, loc, mlir::arith::CmpIPredicate::ne,4949 excepts, zero));4950 fir::StoreOp::create(builder, loc, logicalResult, flagValue);4951}4952 4953// IEEE_GET_HALTING_MODE4954void IntrinsicLibrary::genIeeeGetHaltingMode(4955 llvm::ArrayRef<fir::ExtendedValue> args) {4956 // Set HALTING=.TRUE. if the exception specified by FLAG will cause halting.4957 assert(args.size() == 2);4958 mlir::Value flag = fir::getBase(args[0]);4959 mlir::Value halting = fir::getBase(args[1]);4960 mlir::Type resultTy =4961 mlir::dyn_cast<fir::ReferenceType>(halting.getType()).getEleTy();4962 mlir::Type i32Ty = builder.getIntegerType(32);4963 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);4964 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);4965 mlir::Value field = fir::LoadOp::create(builder, loc, fieldRef);4966 mlir::Value haltSet = fir::runtime::genFegetexcept(builder, loc);4967 mlir::Value intResult = mlir::arith::AndIOp::create(4968 builder, loc, haltSet,4969 fir::runtime::genMapExcept(4970 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, field)));4971 mlir::Value logicalResult = fir::ConvertOp::create(4972 builder, loc, resultTy,4973 mlir::arith::CmpIOp::create(builder, loc, mlir::arith::CmpIPredicate::ne,4974 intResult, zero));4975 fir::StoreOp::create(builder, loc, logicalResult, halting);4976}4977 4978// IEEE_GET_MODES, IEEE_SET_MODES4979// IEEE_GET_STATUS, IEEE_SET_STATUS4980template <bool isGet, bool isModes>4981void IntrinsicLibrary::genIeeeGetOrSetModesOrStatus(4982 llvm::ArrayRef<fir::ExtendedValue> args) {4983 assert(args.size() == 1);4984#ifndef __GLIBC_USE_IEC_60559_BFP_EXT // only use of "#include <cfenv>"4985 // No definitions of fegetmode, fesetmode4986 llvm::StringRef func = isModes4987 ? (isGet ? "ieee_get_modes" : "ieee_set_modes")4988 : (isGet ? "ieee_get_status" : "ieee_set_status");4989 TODO(loc, "intrinsic module procedure: " + func);4990#else4991 mlir::Type i32Ty = builder.getIntegerType(32);4992 mlir::Type i64Ty = builder.getIntegerType(64);4993 mlir::Type ptrTy = builder.getRefType(i32Ty);4994 mlir::Value addr;4995 if (fir::getTargetTriple(builder.getModule()).isSPARC()) {4996 // Floating point environment data is larger than the __data field4997 // allotment. Allocate data space from the heap.4998 auto [fieldRef, fieldTy] =4999 getFieldRef(builder, loc, fir::getBase(args[0]), 1);5000 addr = fir::BoxAddrOp::create(builder, loc,5001 fir::LoadOp::create(builder, loc, fieldRef));5002 mlir::Type heapTy = addr.getType();5003 mlir::Value allocated = mlir::arith::CmpIOp::create(5004 builder, loc, mlir::arith::CmpIPredicate::ne,5005 builder.createConvert(loc, i64Ty, addr),5006 builder.createIntegerConstant(loc, i64Ty, 0));5007 auto ifOp = fir::IfOp::create(builder, loc, heapTy, allocated,5008 /*withElseRegion=*/true);5009 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5010 fir::ResultOp::create(builder, loc, addr);5011 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());5012 mlir::Value byteSize =5013 isModes ? fir::runtime::genGetModesTypeSize(builder, loc)5014 : fir::runtime::genGetStatusTypeSize(builder, loc);5015 byteSize = builder.createConvert(loc, builder.getIndexType(), byteSize);5016 addr = fir::AllocMemOp::create(builder, loc, extractSequenceType(heapTy),5017 /*typeparams=*/mlir::ValueRange(), byteSize);5018 mlir::Value shape = fir::ShapeOp::create(builder, loc, byteSize);5019 fir::StoreOp::create(5020 builder, loc, fir::EmboxOp::create(builder, loc, fieldTy, addr, shape),5021 fieldRef);5022 fir::ResultOp::create(builder, loc, addr);5023 builder.setInsertionPointAfter(ifOp);5024 addr = fir::ConvertOp::create(builder, loc, ptrTy, ifOp.getResult(0));5025 } else {5026 // Place floating point environment data in __data storage.5027 addr = fir::ConvertOp::create(builder, loc, ptrTy, getBase(args[0]));5028 }5029 llvm::StringRef func = isModes ? (isGet ? "fegetmode" : "fesetmode")5030 : (isGet ? "fegetenv" : "fesetenv");5031 genRuntimeCall(func, i32Ty, addr);5032#endif5033}5034 5035// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.5036static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc,5037 mlir::Value radix, std::string procName) {5038 mlir::Value notTwo = mlir::arith::CmpIOp::create(5039 builder, loc, mlir::arith::CmpIPredicate::ne, radix,5040 builder.createIntegerConstant(loc, radix.getType(), 2));5041 auto ifOp = fir::IfOp::create(builder, loc, notTwo,5042 /*withElseRegion=*/false);5043 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5044 fir::runtime::genReportFatalUserError(builder, loc,5045 procName + " radix argument must be 2");5046 builder.setInsertionPointAfter(ifOp);5047}5048 5049// IEEE_GET_ROUNDING_MODE5050void IntrinsicLibrary::genIeeeGetRoundingMode(5051 llvm::ArrayRef<fir::ExtendedValue> args) {5052 // Set arg ROUNDING_VALUE to the current floating point rounding mode.5053 // Values are chosen to match the llvm.get.rounding encoding.5054 // Generate an error if the value of optional arg RADIX is not 2.5055 assert(args.size() == 1 || args.size() == 2);5056 if (args.size() == 2)5057 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode");5058 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));5059 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);5060 mlir::Value mode = fir::CallOp::create(builder, loc, getRound).getResult(0);5061 mode = builder.createConvert(loc, fieldTy, mode);5062 fir::StoreOp::create(builder, loc, mode, fieldRef);5063}5064 5065// IEEE_GET_UNDERFLOW_MODE5066void IntrinsicLibrary::genIeeeGetUnderflowMode(5067 llvm::ArrayRef<fir::ExtendedValue> args) {5068 assert(args.size() == 1);5069 mlir::Value flag = fir::runtime::genGetUnderflowMode(builder, loc);5070 builder.createStoreWithConvert(loc, flag, fir::getBase(args[0]));5071}5072 5073// IEEE_INT5074mlir::Value IntrinsicLibrary::genIeeeInt(mlir::Type resultType,5075 llvm::ArrayRef<mlir::Value> args) {5076 // Convert real argument A to an integer, with rounding according to argument5077 // ROUND. Signal IEEE_INVALID if A is a NaN, an infinity, or out of range,5078 // and return either the largest or smallest integer result value (*).5079 // For valid results (when IEEE_INVALID is not signaled), signal IEEE_INEXACT5080 // if A is not an exact integral value (*). The (*) choices are processor5081 // dependent implementation choices not mandated by the standard.5082 // The primary result is generated with a call to IEEE_RINT.5083 assert(args.size() == 3);5084 mlir::FloatType realType = mlir::cast<mlir::FloatType>(args[0].getType());5085 mlir::Value realResult = genIeeeRint(realType, {args[0], args[1]});5086 int intWidth = mlir::cast<mlir::IntegerType>(resultType).getWidth();5087 mlir::Value intLBound = mlir::arith::ConstantOp::create(5088 builder, loc, resultType,5089 builder.getIntegerAttr(resultType,5090 llvm::APInt::getBitsSet(intWidth,5091 /*lo=*/intWidth - 1,5092 /*hi=*/intWidth)));5093 mlir::Value intUBound = mlir::arith::ConstantOp::create(5094 builder, loc, resultType,5095 builder.getIntegerAttr(resultType,5096 llvm::APInt::getBitsSet(intWidth, /*lo=*/0,5097 /*hi=*/intWidth - 1)));5098 mlir::Value realLBound =5099 fir::ConvertOp::create(builder, loc, realType, intLBound);5100 mlir::Value realUBound =5101 mlir::arith::NegFOp::create(builder, loc, realLBound);5102 mlir::Value aGreaterThanLBound = mlir::arith::CmpFOp::create(5103 builder, loc, mlir::arith::CmpFPredicate::OGE, realResult, realLBound);5104 mlir::Value aLessThanUBound = mlir::arith::CmpFOp::create(5105 builder, loc, mlir::arith::CmpFPredicate::OLT, realResult, realUBound);5106 mlir::Value resultIsValid = mlir::arith::AndIOp::create(5107 builder, loc, aGreaterThanLBound, aLessThanUBound);5108 5109 // Result is valid. It may be exact or inexact.5110 mlir::Value result;5111 fir::IfOp ifOp = fir::IfOp::create(builder, loc, resultType, resultIsValid,5112 /*withElseRegion=*/true);5113 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5114 mlir::Value inexact = mlir::arith::CmpFOp::create(5115 builder, loc, mlir::arith::CmpFPredicate::ONE, args[0], realResult);5116 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact);5117 result = fir::ConvertOp::create(builder, loc, resultType, realResult);5118 fir::ResultOp::create(builder, loc, result);5119 5120 // Result is invalid.5121 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());5122 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID);5123 result = mlir::arith::SelectOp::create(builder, loc, aGreaterThanLBound,5124 intUBound, intLBound);5125 fir::ResultOp::create(builder, loc, result);5126 builder.setInsertionPointAfter(ifOp);5127 return ifOp.getResult(0);5128}5129 5130// IEEE_IS_FINITE5131mlir::Value5132IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,5133 llvm::ArrayRef<mlir::Value> args) {5134 // Check if arg X is a (negative or positive) (normal, denormal, or zero).5135 assert(args.size() == 1);5136 return genIsFPClass(resultType, args, finiteTest);5137}5138 5139// IEEE_IS_NAN5140mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType,5141 llvm::ArrayRef<mlir::Value> args) {5142 // Check if arg X is a (signaling or quiet) NaN.5143 assert(args.size() == 1);5144 return genIsFPClass(resultType, args, nanTest);5145}5146 5147// IEEE_IS_NEGATIVE5148mlir::Value5149IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType,5150 llvm::ArrayRef<mlir::Value> args) {5151 // Check if arg X is a negative (infinity, normal, denormal or zero).5152 assert(args.size() == 1);5153 return genIsFPClass(resultType, args, negativeTest);5154}5155 5156// IEEE_IS_NORMAL5157mlir::Value5158IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,5159 llvm::ArrayRef<mlir::Value> args) {5160 // Check if arg X is a (negative or positive) (normal or zero).5161 assert(args.size() == 1);5162 return genIsFPClass(resultType, args, normalTest);5163}5164 5165// IEEE_LOGB5166mlir::Value IntrinsicLibrary::genIeeeLogb(mlir::Type resultType,5167 llvm::ArrayRef<mlir::Value> args) {5168 // Exponent of X, with special case treatment for some input values.5169 // Return: X == 05170 // ? -infinity (and raise FE_DIVBYZERO)5171 // : ieee_is_finite(X)5172 // ? exponent(X) - 1 // unbiased exponent of X5173 // : ieee_copy_sign(X, 1.0) // +infinity or NaN5174 assert(args.size() == 1);5175 mlir::Value realVal = args[0];5176 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());5177 int bitWidth = realType.getWidth();5178 mlir::Type intType = builder.getIntegerType(realType.getWidth());5179 mlir::Value intVal =5180 mlir::arith::BitcastOp::create(builder, loc, intType, realVal);5181 mlir::Type i1Ty = builder.getI1Type();5182 5183 int exponentBias, significandSize, nonSignificandSize;5184 switch (bitWidth) {5185 case 16:5186 if (realType.isF16()) {5187 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits5188 exponentBias = (1 << (5 - 1)) - 1; // 155189 significandSize = 10;5190 nonSignificandSize = 6;5191 break;5192 }5193 assert(realType.isBF16() && "unknown 16-bit real type");5194 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits5195 exponentBias = (1 << (8 - 1)) - 1; // 1275196 significandSize = 7;5197 nonSignificandSize = 9;5198 break;5199 case 32:5200 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits5201 exponentBias = (1 << (8 - 1)) - 1; // 1275202 significandSize = 23;5203 nonSignificandSize = 9;5204 break;5205 case 64:5206 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits5207 exponentBias = (1 << (11 - 1)) - 1; // 10235208 significandSize = 52;5209 nonSignificandSize = 12;5210 break;5211 case 80:5212 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits5213 exponentBias = (1 << (15 - 1)) - 1; // 163835214 significandSize = 64;5215 nonSignificandSize = 16 + 1;5216 break;5217 case 128:5218 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits5219 exponentBias = (1 << (15 - 1)) - 1; // 163835220 significandSize = 112;5221 nonSignificandSize = 16;5222 break;5223 default:5224 llvm_unreachable("unknown real type");5225 }5226 5227 mlir::Value isZero = mlir::arith::CmpFOp::create(5228 builder, loc, mlir::arith::CmpFPredicate::OEQ, realVal,5229 builder.createRealZeroConstant(loc, resultType));5230 auto outerIfOp = fir::IfOp::create(builder, loc, resultType, isZero,5231 /*withElseRegion=*/true);5232 // X is zero -- result is -infinity5233 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());5234 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO);5235 mlir::Value ones = builder.createAllOnesInteger(loc, intType);5236 mlir::Value result = mlir::arith::ShLIOp::create(5237 builder, loc, ones,5238 builder.createIntegerConstant(loc, intType,5239 // kind=10 high-order bit is explicit5240 significandSize - (bitWidth == 80)));5241 result = mlir::arith::BitcastOp::create(builder, loc, resultType, result);5242 fir::ResultOp::create(builder, loc, result);5243 5244 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());5245 mlir::Value one = builder.createIntegerConstant(loc, intType, 1);5246 mlir::Value shiftLeftOne =5247 mlir::arith::ShLIOp::create(builder, loc, intVal, one);5248 mlir::Value isFinite = genIsFPClass(i1Ty, args, finiteTest);5249 auto innerIfOp = fir::IfOp::create(builder, loc, resultType, isFinite,5250 /*withElseRegion=*/true);5251 // X is non-zero finite -- result is unbiased exponent of X5252 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());5253 mlir::Value isNormal = genIsFPClass(i1Ty, args, normalTest);5254 auto normalIfOp = fir::IfOp::create(builder, loc, resultType, isNormal,5255 /*withElseRegion=*/true);5256 // X is normal5257 builder.setInsertionPointToStart(&normalIfOp.getThenRegion().front());5258 mlir::Value biasedExponent = mlir::arith::ShRUIOp::create(5259 builder, loc, shiftLeftOne,5260 builder.createIntegerConstant(loc, intType, significandSize + 1));5261 result = mlir::arith::SubIOp::create(5262 builder, loc, biasedExponent,5263 builder.createIntegerConstant(loc, intType, exponentBias));5264 result = fir::ConvertOp::create(builder, loc, resultType, result);5265 fir::ResultOp::create(builder, loc, result);5266 5267 // X is denormal -- result is (-exponentBias - ctlz(significand))5268 builder.setInsertionPointToStart(&normalIfOp.getElseRegion().front());5269 mlir::Value significand = mlir::arith::ShLIOp::create(5270 builder, loc, intVal,5271 builder.createIntegerConstant(loc, intType, nonSignificandSize));5272 mlir::Value ctlz =5273 mlir::math::CountLeadingZerosOp::create(builder, loc, significand);5274 mlir::Type i32Ty = builder.getI32Type();5275 result = mlir::arith::SubIOp::create(5276 builder, loc, builder.createIntegerConstant(loc, i32Ty, -exponentBias),5277 fir::ConvertOp::create(builder, loc, i32Ty, ctlz));5278 result = fir::ConvertOp::create(builder, loc, resultType, result);5279 fir::ResultOp::create(builder, loc, result);5280 5281 builder.setInsertionPointToEnd(&innerIfOp.getThenRegion().front());5282 fir::ResultOp::create(builder, loc, normalIfOp.getResult(0));5283 5284 // X is infinity or NaN -- result is +infinity or NaN5285 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());5286 result = mlir::arith::ShRUIOp::create(builder, loc, shiftLeftOne, one);5287 result = mlir::arith::BitcastOp::create(builder, loc, resultType, result);5288 fir::ResultOp::create(builder, loc, result);5289 5290 // Unwind the if nest.5291 builder.setInsertionPointToEnd(&outerIfOp.getElseRegion().front());5292 fir::ResultOp::create(builder, loc, innerIfOp.getResult(0));5293 builder.setInsertionPointAfter(outerIfOp);5294 return outerIfOp.getResult(0);5295}5296 5297// IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG5298// IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG5299template <bool isMax, bool isNum, bool isMag>5300mlir::Value IntrinsicLibrary::genIeeeMaxMin(mlir::Type resultType,5301 llvm::ArrayRef<mlir::Value> args) {5302 // Maximum/minimum of X and Y with special case treatment of NaN operands.5303 // The f18 definitions of these procedures (where applicable) are incomplete.5304 // And f18 results involving NaNs are different from and incompatible with5305 // f23 results. This code implements the f23 procedures.5306 // For IEEE_MAX_MAG and IEEE_MAX_NUM_MAG:5307 // if (ABS(X) > ABS(Y))5308 // return X5309 // else if (ABS(Y) > ABS(X))5310 // return Y5311 // else if (ABS(X) == ABS(Y))5312 // return IEEE_SIGNBIT(Y) ? X : Y5313 // // X or Y or both are NaNs5314 // if (X is an sNaN or Y is an sNaN) raise FE_INVALID5315 // if (IEEE_MAX_NUM_MAG and X is not a NaN) return X5316 // if (IEEE_MAX_NUM_MAG and Y is not a NaN) return Y5317 // return a qNaN5318 // For IEEE_MAX, IEEE_MAX_NUM: compare X vs. Y rather than ABS(X) vs. ABS(Y)5319 // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG: invert comparisons5320 assert(args.size() == 2);5321 mlir::Value x = args[0];5322 mlir::Value y = args[1];5323 mlir::Value x1, y1; // X or ABS(X), Y or ABS(Y)5324 if constexpr (isMag) {5325 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);5326 x1 = mlir::math::CopySignOp::create(builder, loc, x, zero);5327 y1 = mlir::math::CopySignOp::create(builder, loc, y, zero);5328 } else {5329 x1 = x;5330 y1 = y;5331 }5332 mlir::Type i1Ty = builder.getI1Type();5333 mlir::arith::CmpFPredicate pred;5334 mlir::Value cmp, result, resultIsX, resultIsY;5335 5336 // X1 < Y1 -- MAX result is Y; MIN result is X.5337 pred = mlir::arith::CmpFPredicate::OLT;5338 cmp = mlir::arith::CmpFOp::create(builder, loc, pred, x1, y1);5339 auto ifOp1 = fir::IfOp::create(builder, loc, resultType, cmp, true);5340 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());5341 result = isMax ? y : x;5342 fir::ResultOp::create(builder, loc, result);5343 5344 // X1 > Y1 -- MAX result is X; MIN result is Y.5345 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());5346 pred = mlir::arith::CmpFPredicate::OGT;5347 cmp = mlir::arith::CmpFOp::create(builder, loc, pred, x1, y1);5348 auto ifOp2 = fir::IfOp::create(builder, loc, resultType, cmp, true);5349 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());5350 result = isMax ? x : y;5351 fir::ResultOp::create(builder, loc, result);5352 5353 // X1 == Y1 -- MAX favors a positive result; MIN favors a negative result.5354 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());5355 pred = mlir::arith::CmpFPredicate::OEQ;5356 cmp = mlir::arith::CmpFOp::create(builder, loc, pred, x1, y1);5357 auto ifOp3 = fir::IfOp::create(builder, loc, resultType, cmp, true);5358 builder.setInsertionPointToStart(&ifOp3.getThenRegion().front());5359 resultIsX = isMax ? genIsFPClass(i1Ty, x, positiveTest)5360 : genIsFPClass(i1Ty, x, negativeTest);5361 result = mlir::arith::SelectOp::create(builder, loc, resultIsX, x, y);5362 fir::ResultOp::create(builder, loc, result);5363 5364 // X or Y or both are NaNs -- result may be X, Y, or a qNaN5365 builder.setInsertionPointToStart(&ifOp3.getElseRegion().front());5366 if constexpr (isNum) {5367 pred = mlir::arith::CmpFPredicate::ORD; // check for a non-NaN5368 resultIsX = mlir::arith::CmpFOp::create(builder, loc, pred, x, x);5369 resultIsY = mlir::arith::CmpFOp::create(builder, loc, pred, y, y);5370 } else {5371 resultIsX = resultIsY = builder.createBool(loc, false);5372 }5373 result = mlir::arith::SelectOp::create(5374 builder, loc, resultIsX, x,5375 mlir::arith::SelectOp::create(builder, loc, resultIsY, y,5376 genQNan(resultType)));5377 mlir::Value hasSNaNOp = mlir::arith::OrIOp::create(5378 builder, loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),5379 genIsFPClass(builder.getI1Type(), args[1], snanTest));5380 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);5381 fir::ResultOp::create(builder, loc, result);5382 5383 // Unwind the if nest.5384 builder.setInsertionPointAfter(ifOp3);5385 fir::ResultOp::create(builder, loc, ifOp3.getResult(0));5386 builder.setInsertionPointAfter(ifOp2);5387 fir::ResultOp::create(builder, loc, ifOp2.getResult(0));5388 builder.setInsertionPointAfter(ifOp1);5389 return ifOp1.getResult(0);5390}5391 5392// IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,5393// IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE5394template <mlir::arith::CmpFPredicate pred>5395mlir::Value5396IntrinsicLibrary::genIeeeQuietCompare(mlir::Type resultType,5397 llvm::ArrayRef<mlir::Value> args) {5398 // Compare X and Y with special case treatment of NaN operands.5399 assert(args.size() == 2);5400 mlir::Value hasSNaNOp = mlir::arith::OrIOp::create(5401 builder, loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),5402 genIsFPClass(builder.getI1Type(), args[1], snanTest));5403 mlir::Value res =5404 mlir::arith::CmpFOp::create(builder, loc, pred, args[0], args[1]);5405 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);5406 return fir::ConvertOp::create(builder, loc, resultType, res);5407}5408 5409// IEEE_REAL5410mlir::Value IntrinsicLibrary::genIeeeReal(mlir::Type resultType,5411 llvm::ArrayRef<mlir::Value> args) {5412 // Convert integer or real argument A to a real of a specified kind.5413 // Round according to the current rounding mode.5414 // Signal IEEE_INVALID if A is an sNaN, and return a qNaN.5415 // Signal IEEE_UNDERFLOW for an inexact subnormal or zero result.5416 // Signal IEEE_OVERFLOW if A is finite and the result is infinite.5417 // Signal IEEE_INEXACT for an inexact result.5418 //5419 // if (type(a) == resultType) {5420 // // Conversion to the same type is a nop except for sNaN processing.5421 // result = a5422 // } else {5423 // result = r = real(a, kind(result))5424 // // Conversion to a larger type is exact.5425 // if (c_sizeof(a) >= c_sizeof(r)) {5426 // b = (a is integer) ? int(r, kind(a)) : real(r, kind(a))5427 // if (a == b || isNaN(a)) {5428 // // a is {-0, +0, -inf, +inf, NaN} or exact; result is r5429 // } else {5430 // // odd(r) is true if the low bit of significand(r) is 15431 // // rounding mode ieee_other is an alias for mode ieee_nearest5432 // if (a < b) {5433 // if (mode == ieee_nearest && odd(r)) result = ieee_next_down(r)5434 // if (mode == ieee_other && odd(r)) result = ieee_next_down(r)5435 // if (mode == ieee_to_zero && a > 0) result = ieee_next_down(r)5436 // if (mode == ieee_away && a < 0) result = ieee_next_down(r)5437 // if (mode == ieee_down) result = ieee_next_down(r)5438 // } else { // a > b5439 // if (mode == ieee_nearest && odd(r)) result = ieee_next_up(r)5440 // if (mode == ieee_other && odd(r)) result = ieee_next_up(r)5441 // if (mode == ieee_to_zero && a < 0) result = ieee_next_up(r)5442 // if (mode == ieee_away && a > 0) result = ieee_next_up(r)5443 // if (mode == ieee_up) result = ieee_next_up(r)5444 // }5445 // }5446 // }5447 // }5448 5449 assert(args.size() == 2);5450 mlir::Type i1Ty = builder.getI1Type();5451 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());5452 mlir::Value a = args[0];5453 mlir::Type aType = a.getType();5454 5455 // If the argument is an sNaN, raise an invalid exception and return a qNaN.5456 // Otherwise return the argument.5457 auto processSnan = [&](mlir::Value x) {5458 fir::IfOp ifOp = fir::IfOp::create(builder, loc, resultType,5459 genIsFPClass(i1Ty, x, snanTest),5460 /*withElseRegion=*/true);5461 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5462 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID);5463 fir::ResultOp::create(builder, loc, genQNan(resultType));5464 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());5465 fir::ResultOp::create(builder, loc, x);5466 builder.setInsertionPointAfter(ifOp);5467 return ifOp.getResult(0);5468 };5469 5470 // Conversion is a nop, except that A may be an sNaN.5471 if (resultType == aType)5472 return processSnan(a);5473 5474 // Can't directly convert between kind=2 and kind=3.5475 mlir::Value r, r1;5476 if ((aType.isBF16() && resultType.isF16()) ||5477 (aType.isF16() && resultType.isBF16())) {5478 a = builder.createConvert(loc, f32Ty, a);5479 aType = f32Ty;5480 }5481 r = fir::ConvertOp::create(builder, loc, resultType, a);5482 5483 mlir::IntegerType aIntType = mlir::dyn_cast<mlir::IntegerType>(aType);5484 mlir::FloatType aFloatType = mlir::dyn_cast<mlir::FloatType>(aType);5485 mlir::FloatType resultFloatType = mlir::dyn_cast<mlir::FloatType>(resultType);5486 5487 // Conversion from a smaller type to a larger type is exact.5488 if ((aIntType ? aIntType.getWidth() : aFloatType.getWidth()) <5489 resultFloatType.getWidth())5490 return aIntType ? r : processSnan(r);5491 5492 // A possibly inexact conversion result may need to be rounded up or down.5493 mlir::Value b = fir::ConvertOp::create(builder, loc, aType, r);5494 mlir::Value aEqB;5495 if (aIntType)5496 aEqB = mlir::arith::CmpIOp::create(builder, loc,5497 mlir::arith::CmpIPredicate::eq, a, b);5498 else5499 aEqB = mlir::arith::CmpFOp::create(builder, loc,5500 mlir::arith::CmpFPredicate::UEQ, a, b);5501 5502 // [a == b] a is a NaN or r is exact (a may be -0, +0, -inf, +inf) -- return r5503 fir::IfOp ifOp1 = fir::IfOp::create(builder, loc, resultType, aEqB,5504 /*withElseRegion=*/true);5505 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());5506 fir::ResultOp::create(builder, loc, aIntType ? r : processSnan(r));5507 5508 // Code common to (a < b) and (a > b) branches.5509 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());5510 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);5511 mlir::Value mode = fir::CallOp::create(builder, loc, getRound).getResult(0);5512 mlir::Value aIsNegative, aIsPositive;5513 if (aIntType) {5514 mlir::Value zero = builder.createIntegerConstant(loc, aIntType, 0);5515 aIsNegative = mlir::arith::CmpIOp::create(5516 builder, loc, mlir::arith::CmpIPredicate::slt, a, zero);5517 aIsPositive = mlir::arith::CmpIOp::create(5518 builder, loc, mlir::arith::CmpIPredicate::sgt, a, zero);5519 } else {5520 mlir::Value zero = builder.createRealZeroConstant(loc, aFloatType);5521 aIsNegative = mlir::arith::CmpFOp::create(5522 builder, loc, mlir::arith::CmpFPredicate::OLT, a, zero);5523 aIsPositive = mlir::arith::CmpFOp::create(5524 builder, loc, mlir::arith::CmpFPredicate::OGT, a, zero);5525 }5526 mlir::Type resultIntType = builder.getIntegerType(resultFloatType.getWidth());5527 mlir::Value resultCast =5528 mlir::arith::BitcastOp::create(builder, loc, resultIntType, r);5529 mlir::Value one = builder.createIntegerConstant(loc, resultIntType, 1);5530 mlir::Value rIsOdd = fir::ConvertOp::create(5531 builder, loc, i1Ty,5532 mlir::arith::AndIOp::create(builder, loc, resultCast, one));5533 // Check for a rounding mode match.5534 auto match = [&](int m) {5535 return mlir::arith::CmpIOp::create(5536 builder, loc, mlir::arith::CmpIPredicate::eq, mode,5537 builder.createIntegerConstant(loc, mode.getType(), m));5538 };5539 mlir::Value roundToNearestBit = mlir::arith::OrIOp::create(5540 builder, loc,5541 // IEEE_OTHER is an alias for IEEE_NEAREST.5542 match(_FORTRAN_RUNTIME_IEEE_NEAREST), match(_FORTRAN_RUNTIME_IEEE_OTHER));5543 mlir::Value roundToNearest =5544 mlir::arith::AndIOp::create(builder, loc, roundToNearestBit, rIsOdd);5545 mlir::Value roundToZeroBit = match(_FORTRAN_RUNTIME_IEEE_TO_ZERO);5546 mlir::Value roundAwayBit = match(_FORTRAN_RUNTIME_IEEE_AWAY);5547 mlir::Value roundToZero, roundAway, mustAdjust;5548 fir::IfOp adjustIfOp;5549 mlir::Value aLtB;5550 if (aIntType)5551 aLtB = mlir::arith::CmpIOp::create(builder, loc,5552 mlir::arith::CmpIPredicate::slt, a, b);5553 else5554 aLtB = mlir::arith::CmpFOp::create(builder, loc,5555 mlir::arith::CmpFPredicate::OLT, a, b);5556 mlir::Value upResult =5557 mlir::arith::AddIOp::create(builder, loc, resultCast, one);5558 mlir::Value downResult =5559 mlir::arith::SubIOp::create(builder, loc, resultCast, one);5560 5561 // (a < b): r is inexact -- return r or ieee_next_down(r)5562 fir::IfOp ifOp2 = fir::IfOp::create(builder, loc, resultType, aLtB,5563 /*withElseRegion=*/true);5564 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());5565 roundToZero =5566 mlir::arith::AndIOp::create(builder, loc, roundToZeroBit, aIsPositive);5567 roundAway =5568 mlir::arith::AndIOp::create(builder, loc, roundAwayBit, aIsNegative);5569 mlir::Value roundDown = match(_FORTRAN_RUNTIME_IEEE_DOWN);5570 mustAdjust =5571 mlir::arith::OrIOp::create(builder, loc, roundToNearest, roundToZero);5572 mustAdjust = mlir::arith::OrIOp::create(builder, loc, mustAdjust, roundAway);5573 mustAdjust = mlir::arith::OrIOp::create(builder, loc, mustAdjust, roundDown);5574 adjustIfOp = fir::IfOp::create(builder, loc, resultType, mustAdjust,5575 /*withElseRegion=*/true);5576 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front());5577 if (resultType.isF80())5578 r1 = fir::runtime::genNearest(builder, loc, r,5579 builder.createBool(loc, false));5580 else5581 r1 = mlir::arith::BitcastOp::create(5582 builder, loc, resultType,5583 mlir::arith::SelectOp::create(builder, loc, aIsNegative, upResult,5584 downResult));5585 fir::ResultOp::create(builder, loc, r1);5586 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front());5587 fir::ResultOp::create(builder, loc, r);5588 builder.setInsertionPointAfter(adjustIfOp);5589 fir::ResultOp::create(builder, loc, adjustIfOp.getResult(0));5590 5591 // (a > b): r is inexact -- return r or ieee_next_up(r)5592 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());5593 roundToZero =5594 mlir::arith::AndIOp::create(builder, loc, roundToZeroBit, aIsNegative);5595 roundAway =5596 mlir::arith::AndIOp::create(builder, loc, roundAwayBit, aIsPositive);5597 mlir::Value roundUp = match(_FORTRAN_RUNTIME_IEEE_UP);5598 mustAdjust =5599 mlir::arith::OrIOp::create(builder, loc, roundToNearest, roundToZero);5600 mustAdjust = mlir::arith::OrIOp::create(builder, loc, mustAdjust, roundAway);5601 mustAdjust = mlir::arith::OrIOp::create(builder, loc, mustAdjust, roundUp);5602 adjustIfOp = fir::IfOp::create(builder, loc, resultType, mustAdjust,5603 /*withElseRegion=*/true);5604 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front());5605 if (resultType.isF80())5606 r1 = fir::runtime::genNearest(builder, loc, r,5607 builder.createBool(loc, true));5608 else5609 r1 = mlir::arith::BitcastOp::create(5610 builder, loc, resultType,5611 mlir::arith::SelectOp::create(builder, loc, aIsPositive, upResult,5612 downResult));5613 fir::ResultOp::create(builder, loc, r1);5614 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front());5615 fir::ResultOp::create(builder, loc, r);5616 builder.setInsertionPointAfter(adjustIfOp);5617 fir::ResultOp::create(builder, loc, adjustIfOp.getResult(0));5618 5619 // Generate exceptions for (a < b) and (a > b) branches.5620 builder.setInsertionPointAfter(ifOp2);5621 r = ifOp2.getResult(0);5622 fir::IfOp exceptIfOp1 =5623 fir::IfOp::create(builder, loc, genIsFPClass(i1Ty, r, infiniteTest),5624 /*withElseRegion=*/true);5625 builder.setInsertionPointToStart(&exceptIfOp1.getThenRegion().front());5626 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |5627 _FORTRAN_RUNTIME_IEEE_INEXACT);5628 builder.setInsertionPointToStart(&exceptIfOp1.getElseRegion().front());5629 fir::IfOp exceptIfOp2 = fir::IfOp::create(5630 builder, loc, genIsFPClass(i1Ty, r, subnormalTest | zeroTest),5631 /*withElseRegion=*/true);5632 builder.setInsertionPointToStart(&exceptIfOp2.getThenRegion().front());5633 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |5634 _FORTRAN_RUNTIME_IEEE_INEXACT);5635 builder.setInsertionPointToStart(&exceptIfOp2.getElseRegion().front());5636 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT);5637 builder.setInsertionPointAfter(exceptIfOp1);5638 fir::ResultOp::create(builder, loc, ifOp2.getResult(0));5639 builder.setInsertionPointAfter(ifOp1);5640 return ifOp1.getResult(0);5641}5642 5643// IEEE_REM5644mlir::Value IntrinsicLibrary::genIeeeRem(mlir::Type resultType,5645 llvm::ArrayRef<mlir::Value> args) {5646 // Return the remainder of X divided by Y.5647 // Signal IEEE_UNDERFLOW if X is subnormal and Y is infinite.5648 // Signal IEEE_INVALID if X is infinite or Y is zero and neither is a NaN.5649 assert(args.size() == 2);5650 mlir::Value x = args[0];5651 mlir::Value y = args[1];5652 if (mlir::dyn_cast<mlir::FloatType>(resultType).getWidth() < 32) {5653 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());5654 x = fir::ConvertOp::create(builder, loc, f32Ty, x);5655 y = fir::ConvertOp::create(builder, loc, f32Ty, y);5656 } else {5657 x = fir::ConvertOp::create(builder, loc, resultType, x);5658 y = fir::ConvertOp::create(builder, loc, resultType, y);5659 }5660 // remainder calls do not signal IEEE_UNDERFLOW.5661 mlir::Value underflow = mlir::arith::AndIOp::create(5662 builder, loc, genIsFPClass(builder.getI1Type(), x, subnormalTest),5663 genIsFPClass(builder.getI1Type(), y, infiniteTest));5664 mlir::Value result = genRuntimeCall("remainder", x.getType(), {x, y});5665 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW, underflow);5666 return fir::ConvertOp::create(builder, loc, resultType, result);5667}5668 5669// IEEE_RINT5670mlir::Value IntrinsicLibrary::genIeeeRint(mlir::Type resultType,5671 llvm::ArrayRef<mlir::Value> args) {5672 // Return the value of real argument A rounded to an integer value according5673 // to argument ROUND if present, otherwise according to the current rounding5674 // mode. If ROUND is not present, signal IEEE_INEXACT if A is not an exact5675 // integral value.5676 assert(args.size() == 2);5677 mlir::Value a = args[0];5678 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);5679 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);5680 mlir::Value mode;5681 if (isStaticallyPresent(args[1])) {5682 mode = fir::CallOp::create(builder, loc, getRound).getResult(0);5683 genIeeeSetRoundingMode({args[1]});5684 }5685 if (mlir::cast<mlir::FloatType>(resultType).getWidth() == 16)5686 a = fir::ConvertOp::create(builder, loc,5687 mlir::Float32Type::get(builder.getContext()), a);5688 mlir::Value result = fir::ConvertOp::create(5689 builder, loc, resultType, genRuntimeCall("nearbyint", a.getType(), a));5690 if (isStaticallyPresent(args[1])) {5691 fir::CallOp::create(builder, loc, setRound, mode);5692 } else {5693 mlir::Value inexact = mlir::arith::CmpFOp::create(5694 builder, loc, mlir::arith::CmpFPredicate::ONE, args[0], result);5695 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact);5696 }5697 return result;5698}5699 5700// IEEE_SET_FLAG, IEEE_SET_HALTING_MODE5701template <bool isFlag>5702void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode(5703 llvm::ArrayRef<fir::ExtendedValue> args) {5704 // IEEE_SET_FLAG: Set an exception FLAG to a FLAG_VALUE.5705 // IEEE_SET_HALTING: Set an exception halting mode FLAG to a HALTING value.5706 assert(args.size() == 2);5707 mlir::Type i1Ty = builder.getI1Type();5708 mlir::Type i32Ty = builder.getIntegerType(32);5709 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));5710 mlir::Value field = fir::LoadOp::create(builder, loc, fieldRef);5711 mlir::Value except = fir::runtime::genMapExcept(5712 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, field));5713 auto ifOp = fir::IfOp::create(5714 builder, loc,5715 fir::ConvertOp::create(builder, loc, i1Ty, getBase(args[1])),5716 /*withElseRegion=*/true);5717 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5718 (isFlag ? fir::runtime::genFeraiseexcept : fir::runtime::genFeenableexcept)(5719 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, except));5720 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());5721 (isFlag ? fir::runtime::genFeclearexcept : fir::runtime::genFedisableexcept)(5722 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, except));5723 builder.setInsertionPointAfter(ifOp);5724}5725 5726// IEEE_SET_ROUNDING_MODE5727void IntrinsicLibrary::genIeeeSetRoundingMode(5728 llvm::ArrayRef<fir::ExtendedValue> args) {5729 // Set the current floating point rounding mode to the value of arg5730 // ROUNDING_VALUE. Values are llvm.get.rounding encoding values.5731 // Modes ieee_to_zero, ieee_nearest, ieee_up, and ieee_down are supported.5732 // Modes ieee_away and ieee_other are not supported, and are treated as5733 // ieee_nearest. Generate an error if the optional RADIX arg is not 2.5734 assert(args.size() == 1 || args.size() == 2);5735 if (args.size() == 2)5736 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode");5737 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));5738 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);5739 mlir::Value mode = fir::LoadOp::create(builder, loc, fieldRef);5740 static_assert(5741 _FORTRAN_RUNTIME_IEEE_TO_ZERO >= 0 &&5742 _FORTRAN_RUNTIME_IEEE_TO_ZERO <= 3 &&5743 _FORTRAN_RUNTIME_IEEE_NEAREST >= 0 &&5744 _FORTRAN_RUNTIME_IEEE_NEAREST <= 3 && _FORTRAN_RUNTIME_IEEE_UP >= 0 &&5745 _FORTRAN_RUNTIME_IEEE_UP <= 3 && _FORTRAN_RUNTIME_IEEE_DOWN >= 0 &&5746 _FORTRAN_RUNTIME_IEEE_DOWN <= 3 && "unexpected rounding mode mapping");5747 mlir::Value mask = mlir::arith::ShLIOp::create(5748 builder, loc, builder.createAllOnesInteger(loc, fieldTy),5749 builder.createIntegerConstant(loc, fieldTy, 2));5750 mlir::Value modeIsSupported = mlir::arith::CmpIOp::create(5751 builder, loc, mlir::arith::CmpIPredicate::eq,5752 mlir::arith::AndIOp::create(builder, loc, mode, mask),5753 builder.createIntegerConstant(loc, fieldTy, 0));5754 mlir::Value nearest = builder.createIntegerConstant(5755 loc, fieldTy, _FORTRAN_RUNTIME_IEEE_NEAREST);5756 mode = mlir::arith::SelectOp::create(builder, loc, modeIsSupported, mode,5757 nearest);5758 mode = fir::ConvertOp::create(builder, loc,5759 setRound.getFunctionType().getInput(0), mode);5760 fir::CallOp::create(builder, loc, setRound, mode);5761}5762 5763// IEEE_SET_UNDERFLOW_MODE5764void IntrinsicLibrary::genIeeeSetUnderflowMode(5765 llvm::ArrayRef<fir::ExtendedValue> args) {5766 assert(args.size() == 1);5767 mlir::Value gradual = fir::ConvertOp::create(5768 builder, loc, builder.getI1Type(), getBase(args[0]));5769 fir::runtime::genSetUnderflowMode(builder, loc, {gradual});5770}5771 5772// IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,5773// IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE5774template <mlir::arith::CmpFPredicate pred>5775mlir::Value5776IntrinsicLibrary::genIeeeSignalingCompare(mlir::Type resultType,5777 llvm::ArrayRef<mlir::Value> args) {5778 // Compare X and Y with special case treatment of NaN operands.5779 assert(args.size() == 2);5780 mlir::Value hasNaNOp = genIeeeUnordered(mlir::Type{}, args);5781 mlir::Value res =5782 mlir::arith::CmpFOp::create(builder, loc, pred, args[0], args[1]);5783 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasNaNOp);5784 return fir::ConvertOp::create(builder, loc, resultType, res);5785}5786 5787// IEEE_SIGNBIT5788mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,5789 llvm::ArrayRef<mlir::Value> args) {5790 // Check if the sign bit of arg X is set.5791 assert(args.size() == 1);5792 mlir::Value realVal = args[0];5793 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());5794 int bitWidth = realType.getWidth();5795 if (realType == mlir::BFloat16Type::get(builder.getContext())) {5796 // Workaround: can't bitcast or convert real(3) to integer(2) or real(2).5797 realVal = builder.createConvert(5798 loc, mlir::Float32Type::get(builder.getContext()), realVal);5799 bitWidth = 32;5800 }5801 mlir::Type intType = builder.getIntegerType(bitWidth);5802 mlir::Value intVal =5803 mlir::arith::BitcastOp::create(builder, loc, intType, realVal);5804 mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1);5805 mlir::Value sign = mlir::arith::ShRUIOp::create(builder, loc, intVal, shift);5806 return builder.createConvert(loc, resultType, sign);5807}5808 5809// IEEE_SUPPORT_FLAG5810fir::ExtendedValue5811IntrinsicLibrary::genIeeeSupportFlag(mlir::Type resultType,5812 llvm::ArrayRef<fir::ExtendedValue> args) {5813 // Check if a floating point exception flag is supported.5814 assert(args.size() == 1 || args.size() == 2);5815 mlir::Type i1Ty = builder.getI1Type();5816 mlir::Type i32Ty = builder.getIntegerType(32);5817 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, getBase(args[0]));5818 mlir::Value flag = fir::LoadOp::create(builder, loc, fieldRef);5819 mlir::Value standardFlagMask = builder.createIntegerConstant(5820 loc, fieldTy,5821 _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |5822 _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |5823 _FORTRAN_RUNTIME_IEEE_INEXACT);5824 mlir::Value isStandardFlag = mlir::arith::CmpIOp::create(5825 builder, loc, mlir::arith::CmpIPredicate::ne,5826 mlir::arith::AndIOp::create(builder, loc, flag, standardFlagMask),5827 builder.createIntegerConstant(loc, fieldTy, 0));5828 fir::IfOp ifOp = fir::IfOp::create(builder, loc, i1Ty, isStandardFlag,5829 /*withElseRegion=*/true);5830 // Standard flags are supported.5831 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());5832 fir::ResultOp::create(builder, loc, builder.createBool(loc, true));5833 5834 // TargetCharacteristics information for the nonstandard ieee_denorm flag5835 // is not available here. So use a runtime check restricted to possibly5836 // supported kinds.5837 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());5838 bool mayBeSupported = false;5839 if (mlir::Value arg1 = getBase(args[1])) {5840 mlir::Type arg1Ty = arg1.getType();5841 if (auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(arg1.getType()))5842 arg1Ty = eleTy;5843 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(arg1Ty))5844 arg1Ty = seqTy.getEleTy();5845 switch (mlir::dyn_cast<mlir::FloatType>(arg1Ty).getWidth()) {5846 case 16:5847 mayBeSupported = arg1Ty.isBF16(); // kind=35848 break;5849 case 32: // kind=45850 case 64: // kind=85851 mayBeSupported = true;5852 break;5853 }5854 }5855 if (mayBeSupported) {5856 mlir::Value isDenorm = mlir::arith::CmpIOp::create(5857 builder, loc, mlir::arith::CmpIPredicate::eq, flag,5858 builder.createIntegerConstant(loc, fieldTy,5859 _FORTRAN_RUNTIME_IEEE_DENORM));5860 mlir::Value result = mlir::arith::AndIOp::create(5861 builder, loc, isDenorm,5862 fir::runtime::genSupportHalting(5863 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, flag)));5864 fir::ResultOp::create(builder, loc, result);5865 } else {5866 fir::ResultOp::create(builder, loc, builder.createBool(loc, false));5867 }5868 builder.setInsertionPointAfter(ifOp);5869 return builder.createConvert(loc, resultType, ifOp.getResult(0));5870}5871 5872// IEEE_SUPPORT_HALTING5873fir::ExtendedValue IntrinsicLibrary::genIeeeSupportHalting(5874 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {5875 // Check if halting is supported for a floating point exception flag.5876 // Standard flags are all supported. The nonstandard DENORM extension is5877 // not supported, at least for now.5878 assert(args.size() == 1);5879 mlir::Type i32Ty = builder.getIntegerType(32);5880 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));5881 mlir::Value field = fir::LoadOp::create(builder, loc, fieldRef);5882 return builder.createConvert(5883 loc, resultType,5884 fir::runtime::genSupportHalting(5885 builder, loc, fir::ConvertOp::create(builder, loc, i32Ty, field)));5886}5887 5888// IEEE_SUPPORT_ROUNDING5889fir::ExtendedValue IntrinsicLibrary::genIeeeSupportRounding(5890 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {5891 // Check if floating point rounding mode ROUND_VALUE is supported.5892 // Rounding is supported either for all type kinds or none.5893 // An optional X kind argument is therefore ignored.5894 // Values are chosen to match the llvm.get.rounding encoding:5895 // 0 - toward zero [supported]5896 // 1 - to nearest, ties to even [supported] - default5897 // 2 - toward positive infinity [supported]5898 // 3 - toward negative infinity [supported]5899 // 4 - to nearest, ties away from zero [not supported]5900 assert(args.size() == 1 || args.size() == 2);5901 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, getBase(args[0]));5902 mlir::Value mode = fir::LoadOp::create(builder, loc, fieldRef);5903 mlir::Value lbOk = mlir::arith::CmpIOp::create(5904 builder, loc, mlir::arith::CmpIPredicate::sge, mode,5905 builder.createIntegerConstant(loc, fieldTy,5906 _FORTRAN_RUNTIME_IEEE_TO_ZERO));5907 mlir::Value ubOk = mlir::arith::CmpIOp::create(5908 builder, loc, mlir::arith::CmpIPredicate::sle, mode,5909 builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));5910 return builder.createConvert(5911 loc, resultType, mlir::arith::AndIOp::create(builder, loc, lbOk, ubOk));5912}5913 5914// IEEE_SUPPORT_STANDARD5915fir::ExtendedValue IntrinsicLibrary::genIeeeSupportStandard(5916 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {5917 // Check if IEEE standard support is available, which reduces to checking5918 // if halting control is supported, as that is the only support component5919 // that may not be available.5920 assert(args.size() <= 1);5921 mlir::Value overflow = builder.createIntegerConstant(5922 loc, builder.getIntegerType(32), _FORTRAN_RUNTIME_IEEE_OVERFLOW);5923 return builder.createConvert(5924 loc, resultType, fir::runtime::genSupportHalting(builder, loc, overflow));5925}5926 5927// IEEE_UNORDERED5928mlir::Value5929IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,5930 llvm::ArrayRef<mlir::Value> args) {5931 // Check if REAL args X or Y or both are (signaling or quiet) NaNs.5932 // If there is no result type return an i1 result.5933 assert(args.size() == 2);5934 if (args[0].getType() == args[1].getType()) {5935 mlir::Value res = mlir::arith::CmpFOp::create(5936 builder, loc, mlir::arith::CmpFPredicate::UNO, args[0], args[1]);5937 return resultType ? builder.createConvert(loc, resultType, res) : res;5938 }5939 assert(resultType && "expecting a (mixed arg type) unordered result type");5940 mlir::Type i1Ty = builder.getI1Type();5941 mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], nanTest);5942 mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], nanTest);5943 mlir::Value res = mlir::arith::OrIOp::create(builder, loc, xIsNan, yIsNan);5944 return builder.createConvert(loc, resultType, res);5945}5946 5947// IEEE_VALUE5948mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,5949 llvm::ArrayRef<mlir::Value> args) {5950 // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS.5951 // A user call has two arguments:5952 // - arg[0] is X (ignored, since the resultType is provided)5953 // - arg[1] is CLASS, an IEEE_CLASS_TYPE CLASS argument containing an index5954 // A compiler generated call has one argument:5955 // - arg[0] is an index constant5956 assert(args.size() == 1 || args.size() == 2);5957 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(resultType);5958 int bitWidth = realType.getWidth();5959 mlir::Type intType = builder.getIntegerType(bitWidth);5960 mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);5961 constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1;5962 mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy);5963 std::string tableName = RTNAME_STRING(IeeeValueTable_) +5964 std::to_string(realType.isBF16() ? 3 : bitWidth >> 3);5965 if (!builder.getNamedGlobal(tableName)) {5966 llvm::SmallVector<mlir::Attribute, tableSize> values;5967 auto insert = [&](std::int64_t v) {5968 values.push_back(builder.getIntegerAttr(valueTy, v));5969 };5970 insert(0); // placeholder5971 switch (bitWidth) {5972 case 16:5973 if (realType.isF16()) {5974 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits5975 /* IEEE_SIGNALING_NAN */ insert(0x7d00);5976 /* IEEE_QUIET_NAN */ insert(0x7e00);5977 /* IEEE_NEGATIVE_INF */ insert(0xfc00);5978 /* IEEE_NEGATIVE_NORMAL */ insert(0xbc00);5979 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200);5980 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);5981 /* IEEE_POSITIVE_ZERO */ insert(0x0000);5982 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200);5983 /* IEEE_POSITIVE_NORMAL */ insert(0x3c00); // 1.05984 /* IEEE_POSITIVE_INF */ insert(0x7c00);5985 break;5986 }5987 assert(realType.isBF16() && "unknown 16-bit real type");5988 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits5989 /* IEEE_SIGNALING_NAN */ insert(0x7fa0);5990 /* IEEE_QUIET_NAN */ insert(0x7fc0);5991 /* IEEE_NEGATIVE_INF */ insert(0xff80);5992 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf80);5993 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040);5994 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);5995 /* IEEE_POSITIVE_ZERO */ insert(0x0000);5996 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040);5997 /* IEEE_POSITIVE_NORMAL */ insert(0x3f80); // 1.05998 /* IEEE_POSITIVE_INF */ insert(0x7f80);5999 break;6000 case 32:6001 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits6002 /* IEEE_SIGNALING_NAN */ insert(0x7fa00000);6003 /* IEEE_QUIET_NAN */ insert(0x7fc00000);6004 /* IEEE_NEGATIVE_INF */ insert(0xff800000);6005 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf800000);6006 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000);6007 /* IEEE_NEGATIVE_ZERO */ insert(0x80000000);6008 /* IEEE_POSITIVE_ZERO */ insert(0x00000000);6009 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000);6010 /* IEEE_POSITIVE_NORMAL */ insert(0x3f800000); // 1.06011 /* IEEE_POSITIVE_INF */ insert(0x7f800000);6012 break;6013 case 64:6014 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits6015 /* IEEE_SIGNALING_NAN */ insert(0x7ff4000000000000);6016 /* IEEE_QUIET_NAN */ insert(0x7ff8000000000000);6017 /* IEEE_NEGATIVE_INF */ insert(0xfff0000000000000);6018 /* IEEE_NEGATIVE_NORMAL */ insert(0xbff0000000000000);6019 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000);6020 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);6021 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);6022 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000);6023 /* IEEE_POSITIVE_NORMAL */ insert(0x3ff0000000000000); // 1.06024 /* IEEE_POSITIVE_INF */ insert(0x7ff0000000000000);6025 break;6026 case 80:6027 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits6028 // 64 high order bits; 16 low order bits are 0.6029 /* IEEE_SIGNALING_NAN */ insert(0x7fffa00000000000);6030 /* IEEE_QUIET_NAN */ insert(0x7fffc00000000000);6031 /* IEEE_NEGATIVE_INF */ insert(0xffff800000000000);6032 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff800000000000);6033 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000);6034 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);6035 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);6036 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000);6037 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff800000000000); // 1.06038 /* IEEE_POSITIVE_INF */ insert(0x7fff800000000000);6039 break;6040 case 128:6041 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits6042 // 64 high order bits; 64 low order bits are 0.6043 /* IEEE_SIGNALING_NAN */ insert(0x7fff400000000000);6044 /* IEEE_QUIET_NAN */ insert(0x7fff800000000000);6045 /* IEEE_NEGATIVE_INF */ insert(0xffff000000000000);6046 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff000000000000);6047 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000);6048 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);6049 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);6050 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000);6051 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff000000000000); // 1.06052 /* IEEE_POSITIVE_INF */ insert(0x7fff000000000000);6053 break;6054 default:6055 llvm_unreachable("unknown real type");6056 }6057 insert(0); // IEEE_OTHER_VALUE6058 assert(values.size() == tableSize && "ieee value mismatch");6059 builder.createGlobalConstant(6060 loc, tableTy, tableName, builder.createLinkOnceLinkage(),6061 mlir::DenseElementsAttr::get(6062 mlir::RankedTensorType::get(tableSize, valueTy), values));6063 }6064 6065 mlir::Value which;6066 if (args.size() == 2) { // user call6067 auto [index, ignore] = getFieldRef(builder, loc, args[1]);6068 which = fir::LoadOp::create(builder, loc, index);6069 } else { // compiler generated call6070 which = args[0];6071 }6072 mlir::Value bits = fir::LoadOp::create(6073 builder, loc,6074 fir::CoordinateOp::create(6075 builder, loc, builder.getRefType(valueTy),6076 fir::AddrOfOp::create(builder, loc, builder.getRefType(tableTy),6077 builder.getSymbolRefAttr(tableName)),6078 which));6079 if (bitWidth > 64)6080 bits = mlir::arith::ShLIOp::create(6081 builder, loc, builder.createConvert(loc, intType, bits),6082 builder.createIntegerConstant(loc, intType, bitWidth - 64));6083 return mlir::arith::BitcastOp::create(builder, loc, realType, bits);6084}6085 6086// IEOR6087mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,6088 llvm::ArrayRef<mlir::Value> args) {6089 assert(args.size() == 2);6090 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],6091 args[1]);6092}6093 6094// INDEX6095fir::ExtendedValue6096IntrinsicLibrary::genIndex(mlir::Type resultType,6097 llvm::ArrayRef<fir::ExtendedValue> args) {6098 assert(args.size() >= 2 && args.size() <= 4);6099 6100 mlir::Value stringBase = fir::getBase(args[0]);6101 fir::KindTy kind =6102 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(6103 stringBase.getType());6104 mlir::Value stringLen = fir::getLen(args[0]);6105 mlir::Value substringBase = fir::getBase(args[1]);6106 mlir::Value substringLen = fir::getLen(args[1]);6107 mlir::Value back =6108 isStaticallyAbsent(args, 2)6109 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)6110 : fir::getBase(args[2]);6111 if (isStaticallyAbsent(args, 3))6112 return builder.createConvert(6113 loc, resultType,6114 fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,6115 substringBase, substringLen, back));6116 6117 // Call the descriptor-based Index implementation6118 mlir::Value string = builder.createBox(loc, args[0]);6119 mlir::Value substring = builder.createBox(loc, args[1]);6120 auto makeRefThenEmbox = [&](mlir::Value b) {6121 fir::LogicalType logTy = fir::LogicalType::get(6122 builder.getContext(), builder.getKindMap().defaultLogicalKind());6123 mlir::Value temp = builder.createTemporary(loc, logTy);6124 mlir::Value castb = builder.createConvert(loc, logTy, b);6125 fir::StoreOp::create(builder, loc, castb, temp);6126 return builder.createBox(loc, temp);6127 };6128 mlir::Value backOpt =6129 isStaticallyAbsent(args, 2)6130 ? fir::AbsentOp::create(builder, loc,6131 fir::BoxType::get(builder.getI1Type()))6132 : makeRefThenEmbox(fir::getBase(args[2]));6133 mlir::Value kindVal = isStaticallyAbsent(args, 3)6134 ? builder.createIntegerConstant(6135 loc, builder.getIndexType(),6136 builder.getKindMap().defaultIntegerKind())6137 : fir::getBase(args[3]);6138 // Create mutable fir.box to be passed to the runtime for the result.6139 fir::MutableBoxValue mutBox =6140 fir::factory::createTempMutableBox(builder, loc, resultType);6141 mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);6142 // Call runtime. The runtime is allocating the result.6143 fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,6144 backOpt, kindVal);6145 // Read back the result from the mutable box.6146 return readAndAddCleanUp(mutBox, resultType, "INDEX");6147}6148 6149// IOR6150mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,6151 llvm::ArrayRef<mlir::Value> args) {6152 assert(args.size() == 2);6153 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],6154 args[1]);6155}6156 6157// IPARITY6158fir::ExtendedValue6159IntrinsicLibrary::genIparity(mlir::Type resultType,6160 llvm::ArrayRef<fir::ExtendedValue> args) {6161 return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim,6162 "IPARITY", resultType, args);6163}6164 6165// IS_CONTIGUOUS6166fir::ExtendedValue6167IntrinsicLibrary::genIsContiguous(mlir::Type resultType,6168 llvm::ArrayRef<fir::ExtendedValue> args) {6169 assert(args.size() == 1);6170 return builder.createConvert(6171 loc, resultType,6172 fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0])));6173}6174 6175// IS_IOSTAT_END, IS_IOSTAT_EOR6176template <Fortran::runtime::io::Iostat value>6177mlir::Value6178IntrinsicLibrary::genIsIostatValue(mlir::Type resultType,6179 llvm::ArrayRef<mlir::Value> args) {6180 assert(args.size() == 1);6181 return mlir::arith::CmpIOp::create(6182 builder, loc, mlir::arith::CmpIPredicate::eq, args[0],6183 builder.createIntegerConstant(loc, args[0].getType(), value));6184}6185 6186// ISHFT6187mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,6188 llvm::ArrayRef<mlir::Value> args) {6189 // A conformant ISHFT(I,SHIFT) call satisfies:6190 // abs(SHIFT) <= BIT_SIZE(I)6191 // Return: abs(SHIFT) >= BIT_SIZE(I)6192 // ? 06193 // : SHIFT < 06194 // ? I >> abs(SHIFT)6195 // : I << abs(SHIFT)6196 assert(args.size() == 2);6197 int intWidth = resultType.getIntOrFloatBitWidth();6198 mlir::Type signlessType =6199 mlir::IntegerType::get(builder.getContext(), intWidth,6200 mlir::IntegerType::SignednessSemantics::Signless);6201 mlir::Value bitSize =6202 builder.createIntegerConstant(loc, signlessType, intWidth);6203 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);6204 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);6205 mlir::Value absShift = genAbs(signlessType, {shift});6206 mlir::Value word = args[0];6207 if (word.getType().isUnsignedInteger())6208 word = builder.createConvert(loc, signlessType, word);6209 auto left = mlir::arith::ShLIOp::create(builder, loc, word, absShift);6210 auto right = mlir::arith::ShRUIOp::create(builder, loc, word, absShift);6211 auto shiftIsLarge = mlir::arith::CmpIOp::create(6212 builder, loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);6213 auto shiftIsNegative = mlir::arith::CmpIOp::create(6214 builder, loc, mlir::arith::CmpIPredicate::slt, shift, zero);6215 auto sel =6216 mlir::arith::SelectOp::create(builder, loc, shiftIsNegative, right, left);6217 mlir::Value result =6218 mlir::arith::SelectOp::create(builder, loc, shiftIsLarge, zero, sel);6219 if (resultType.isUnsignedInteger())6220 return builder.createConvert(loc, resultType, result);6221 return result;6222}6223 6224// ISHFTC6225mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,6226 llvm::ArrayRef<mlir::Value> args) {6227 // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:6228 // SIZE > 06229 // SIZE <= BIT_SIZE(I)6230 // abs(SHIFT) <= SIZE6231 // if SHIFT > 06232 // leftSize = abs(SHIFT)6233 // rightSize = SIZE - abs(SHIFT)6234 // else [if SHIFT < 0]6235 // leftSize = SIZE - abs(SHIFT)6236 // rightSize = abs(SHIFT)6237 // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE6238 // leftMaskShift = BIT_SIZE(I) - leftSize6239 // rightMaskShift = BIT_SIZE(I) - rightSize6240 // left = (I >> rightSize) & (-1 >> leftMaskShift)6241 // right = (I & (-1 >> rightMaskShift)) << leftSize6242 // Return: SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)6243 assert(args.size() == 3);6244 int intWidth = resultType.getIntOrFloatBitWidth();6245 mlir::Type signlessType =6246 mlir::IntegerType::get(builder.getContext(), intWidth,6247 mlir::IntegerType::SignednessSemantics::Signless);6248 mlir::Value bitSize =6249 builder.createIntegerConstant(loc, signlessType, intWidth);6250 mlir::Value word = args[0];6251 if (word.getType().isUnsignedInteger())6252 word = builder.createConvert(loc, signlessType, word);6253 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);6254 mlir::Value size =6255 args[2] ? builder.createConvert(loc, signlessType, args[2]) : bitSize;6256 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);6257 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);6258 mlir::Value absShift = genAbs(signlessType, {shift});6259 auto elseSize = mlir::arith::SubIOp::create(builder, loc, size, absShift);6260 auto shiftIsZero = mlir::arith::CmpIOp::create(6261 builder, loc, mlir::arith::CmpIPredicate::eq, shift, zero);6262 auto shiftEqualsSize = mlir::arith::CmpIOp::create(6263 builder, loc, mlir::arith::CmpIPredicate::eq, absShift, size);6264 auto shiftIsNop =6265 mlir::arith::OrIOp::create(builder, loc, shiftIsZero, shiftEqualsSize);6266 auto shiftIsPositive = mlir::arith::CmpIOp::create(6267 builder, loc, mlir::arith::CmpIPredicate::sgt, shift, zero);6268 auto leftSize = mlir::arith::SelectOp::create(builder, loc, shiftIsPositive,6269 absShift, elseSize);6270 auto rightSize = mlir::arith::SelectOp::create(builder, loc, shiftIsPositive,6271 elseSize, absShift);6272 auto hasUnchanged = mlir::arith::CmpIOp::create(6273 builder, loc, mlir::arith::CmpIPredicate::ne, size, bitSize);6274 auto unchangedTmp1 = mlir::arith::ShRUIOp::create(builder, loc, word, size);6275 auto unchangedTmp2 =6276 mlir::arith::ShLIOp::create(builder, loc, unchangedTmp1, size);6277 auto unchanged = mlir::arith::SelectOp::create(builder, loc, hasUnchanged,6278 unchangedTmp2, zero);6279 auto leftMaskShift =6280 mlir::arith::SubIOp::create(builder, loc, bitSize, leftSize);6281 auto leftMask =6282 mlir::arith::ShRUIOp::create(builder, loc, ones, leftMaskShift);6283 auto leftTmp = mlir::arith::ShRUIOp::create(builder, loc, word, rightSize);6284 auto left = mlir::arith::AndIOp::create(builder, loc, leftTmp, leftMask);6285 auto rightMaskShift =6286 mlir::arith::SubIOp::create(builder, loc, bitSize, rightSize);6287 auto rightMask =6288 mlir::arith::ShRUIOp::create(builder, loc, ones, rightMaskShift);6289 auto rightTmp = mlir::arith::AndIOp::create(builder, loc, word, rightMask);6290 auto right = mlir::arith::ShLIOp::create(builder, loc, rightTmp, leftSize);6291 auto resTmp = mlir::arith::OrIOp::create(builder, loc, unchanged, left);6292 auto res = mlir::arith::OrIOp::create(builder, loc, resTmp, right);6293 mlir::Value result =6294 mlir::arith::SelectOp::create(builder, loc, shiftIsNop, word, res);6295 if (resultType.isUnsignedInteger())6296 return builder.createConvert(loc, resultType, result);6297 return result;6298}6299 6300// LEADZ6301mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,6302 llvm::ArrayRef<mlir::Value> args) {6303 assert(args.size() == 1);6304 6305 mlir::Value result =6306 mlir::math::CountLeadingZerosOp::create(builder, loc, args);6307 6308 return builder.createConvert(loc, resultType, result);6309}6310 6311// LEN6312// Note that this is only used for an unrestricted intrinsic LEN call.6313// Other uses of LEN are rewritten as descriptor inquiries by the front-end.6314fir::ExtendedValue6315IntrinsicLibrary::genLen(mlir::Type resultType,6316 llvm::ArrayRef<fir::ExtendedValue> args) {6317 // Optional KIND argument reflected in result type and otherwise ignored.6318 assert(args.size() == 1 || args.size() == 2);6319 mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);6320 return builder.createConvert(loc, resultType, len);6321}6322 6323// LEN_TRIM6324fir::ExtendedValue6325IntrinsicLibrary::genLenTrim(mlir::Type resultType,6326 llvm::ArrayRef<fir::ExtendedValue> args) {6327 // Optional KIND argument reflected in result type and otherwise ignored.6328 assert(args.size() == 1 || args.size() == 2);6329 const fir::CharBoxValue *charBox = args[0].getCharBox();6330 if (!charBox)6331 TODO(loc, "intrinsic: len_trim for character array");6332 auto len =6333 fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);6334 return builder.createConvert(loc, resultType, len);6335}6336 6337// LGE, LGT, LLE, LLT6338template <mlir::arith::CmpIPredicate pred>6339fir::ExtendedValue6340IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,6341 llvm::ArrayRef<fir::ExtendedValue> args) {6342 assert(args.size() == 2);6343 return fir::runtime::genCharCompare(6344 builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),6345 fir::getBase(args[1]), fir::getLen(args[1]));6346}6347 6348// LOC6349fir::ExtendedValue6350IntrinsicLibrary::genLoc(mlir::Type resultType,6351 llvm::ArrayRef<fir::ExtendedValue> args) {6352 assert(args.size() == 1);6353 mlir::Value box = fir::getBase(args[0]);6354 assert(fir::isa_box_type(box.getType()) &&6355 "argument must have been lowered to box type");6356 bool isFunc = mlir::isa<fir::BoxProcType>(box.getType());6357 if (!isOptional(box)) {6358 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);6359 return builder.createConvert(loc, resultType, argAddr);6360 }6361 // Optional assumed shape case. Although this is not specified in this GNU6362 // intrinsic extension, LOC accepts absent optional and returns zero in that6363 // case.6364 // Note that the other OPTIONAL cases do not fall here since `box` was6365 // created when preparing the argument cases, but the box can be safely be6366 // used for all those cases and the address will be null if absent.6367 mlir::Value isPresent =6368 fir::IsPresentOp::create(builder, loc, builder.getI1Type(), box);6369 return builder6370 .genIfOp(loc, {resultType}, isPresent,6371 /*withElseRegion=*/true)6372 .genThen([&]() {6373 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);6374 mlir::Value cast = builder.createConvert(loc, resultType, argAddr);6375 fir::ResultOp::create(builder, loc, cast);6376 })6377 .genElse([&]() {6378 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);6379 fir::ResultOp::create(builder, loc, zero);6380 })6381 .getResults()[0];6382}6383 6384mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType,6385 llvm::ArrayRef<mlir::Value> args) {6386 assert(args.size() == 1);6387 return builder.createConvert(loc, resultType,6388 fir::runtime::genMalloc(builder, loc, args[0]));6389}6390 6391// MASKL, MASKR, UMASKL, UMASKR6392template <typename Shift>6393mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,6394 llvm::ArrayRef<mlir::Value> args) {6395 assert(args.size() == 2);6396 6397 int bits = resultType.getIntOrFloatBitWidth();6398 mlir::Type signlessType =6399 mlir::IntegerType::get(builder.getContext(), bits,6400 mlir::IntegerType::SignednessSemantics::Signless);6401 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);6402 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);6403 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);6404 mlir::Value bitsToSet = builder.createConvert(loc, signlessType, args[0]);6405 6406 // The standard does not specify what to return if the number of bits to be6407 // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will6408 // produce a poison value which may return a possibly platform-specific and/or6409 // non-deterministic result. Other compilers don't produce a consistent result6410 // in this case either, so we choose the most efficient implementation.6411 mlir::Value shift =6412 mlir::arith::SubIOp::create(builder, loc, bitSize, bitsToSet);6413 mlir::Value shifted = Shift::create(builder, loc, ones, shift);6414 mlir::Value isZero = mlir::arith::CmpIOp::create(6415 builder, loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero);6416 mlir::Value result =6417 mlir::arith::SelectOp::create(builder, loc, isZero, zero, shifted);6418 if (resultType.isUnsignedInteger())6419 return builder.createConvert(loc, resultType, result);6420 return result;6421}6422 6423// MATMUL6424fir::ExtendedValue6425IntrinsicLibrary::genMatmul(mlir::Type resultType,6426 llvm::ArrayRef<fir::ExtendedValue> args) {6427 assert(args.size() == 2);6428 6429 // Handle required matmul arguments6430 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);6431 mlir::Value matrixA = fir::getBase(matrixTmpA);6432 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);6433 mlir::Value matrixB = fir::getBase(matrixTmpB);6434 unsigned resultRank =6435 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;6436 6437 // Create mutable fir.box to be passed to the runtime for the result.6438 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);6439 fir::MutableBoxValue resultMutableBox =6440 fir::factory::createTempMutableBox(builder, loc, resultArrayType);6441 mlir::Value resultIrBox =6442 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);6443 // Call runtime. The runtime is allocating the result.6444 fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);6445 // Read result from mutable fir.box and add it to the list of temps to be6446 // finalized by the StatementContext.6447 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL");6448}6449 6450// MATMUL_TRANSPOSE6451fir::ExtendedValue6452IntrinsicLibrary::genMatmulTranspose(mlir::Type resultType,6453 llvm::ArrayRef<fir::ExtendedValue> args) {6454 assert(args.size() == 2);6455 6456 // Handle required matmul_transpose arguments6457 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);6458 mlir::Value matrixA = fir::getBase(matrixTmpA);6459 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);6460 mlir::Value matrixB = fir::getBase(matrixTmpB);6461 unsigned resultRank =6462 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;6463 6464 // Create mutable fir.box to be passed to the runtime for the result.6465 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);6466 fir::MutableBoxValue resultMutableBox =6467 fir::factory::createTempMutableBox(builder, loc, resultArrayType);6468 mlir::Value resultIrBox =6469 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);6470 // Call runtime. The runtime is allocating the result.6471 fir::runtime::genMatmulTranspose(builder, loc, resultIrBox, matrixA, matrixB);6472 // Read result from mutable fir.box and add it to the list of temps to be6473 // finalized by the StatementContext.6474 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL_TRANSPOSE");6475}6476 6477// MERGE6478fir::ExtendedValue6479IntrinsicLibrary::genMerge(mlir::Type,6480 llvm::ArrayRef<fir::ExtendedValue> args) {6481 assert(args.size() == 3);6482 mlir::Value tsource = fir::getBase(args[0]);6483 mlir::Value fsource = fir::getBase(args[1]);6484 mlir::Value rawMask = fir::getBase(args[2]);6485 mlir::Type type0 = fir::unwrapRefType(tsource.getType());6486 bool isCharRslt = fir::isa_char(type0); // result is same as first argument6487 mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);6488 6489 // The result is polymorphic if and only if both TSOURCE and FSOURCE are6490 // polymorphic. TSOURCE and FSOURCE are required to have the same type6491 // (for both declared and dynamic types) so a simple convert op can be6492 // used.6493 mlir::Value tsourceCast = tsource;6494 mlir::Value fsourceCast = fsource;6495 auto convertToStaticType = [&](mlir::Value polymorphic,6496 mlir::Value other) -> mlir::Value {6497 mlir::Type otherType = other.getType();6498 if (mlir::isa<fir::BaseBoxType>(otherType))6499 return fir::ReboxOp::create(builder, loc, otherType, polymorphic,6500 /*shape*/ mlir::Value{},6501 /*slice=*/mlir::Value{});6502 return fir::BoxAddrOp::create(builder, loc, otherType, polymorphic);6503 };6504 if (fir::isPolymorphicType(tsource.getType()) &&6505 !fir::isPolymorphicType(fsource.getType())) {6506 tsourceCast = convertToStaticType(tsource, fsource);6507 } else if (!fir::isPolymorphicType(tsource.getType()) &&6508 fir::isPolymorphicType(fsource.getType())) {6509 fsourceCast = convertToStaticType(fsource, tsource);6510 } else {6511 // FSOURCE and TSOURCE are not polymorphic.6512 // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR6513 // types (one can have dynamic length while the other has constant lengths,6514 // or one may be a fir.logical<> while the other is an i1). Insert a cast to6515 // fulfill mlir::SelectOp constraint that the MLIR types must be the same.6516 fsourceCast = builder.createConvert(loc, tsource.getType(), fsource);6517 }6518 auto rslt = mlir::arith::SelectOp::create(builder, loc, mask, tsourceCast,6519 fsourceCast);6520 if (isCharRslt) {6521 // Need a CharBoxValue for character results6522 const fir::CharBoxValue *charBox = args[0].getCharBox();6523 fir::CharBoxValue charRslt(rslt, charBox->getLen());6524 return charRslt;6525 }6526 return rslt;6527}6528 6529// MERGE_BITS6530mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,6531 llvm::ArrayRef<mlir::Value> args) {6532 assert(args.size() == 3);6533 6534 mlir::Type signlessType = mlir::IntegerType::get(6535 builder.getContext(), resultType.getIntOrFloatBitWidth(),6536 mlir::IntegerType::SignednessSemantics::Signless);6537 // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))6538 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);6539 mlir::Value notMask = builder.createUnsigned<mlir::arith::XOrIOp>(6540 loc, resultType, args[2], ones);6541 mlir::Value lft = builder.createUnsigned<mlir::arith::AndIOp>(6542 loc, resultType, args[0], args[2]);6543 mlir::Value rgt = builder.createUnsigned<mlir::arith::AndIOp>(6544 loc, resultType, args[1], notMask);6545 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, lft, rgt);6546}6547 6548// MOD6549static mlir::Value genFastMod(fir::FirOpBuilder &builder, mlir::Location loc,6550 mlir::Value a, mlir::Value p) {6551 auto fastmathFlags = mlir::arith::FastMathFlags::contract;6552 auto fastmathAttr =6553 mlir::arith::FastMathFlagsAttr::get(builder.getContext(), fastmathFlags);6554 mlir::Value divResult =6555 mlir::arith::DivFOp::create(builder, loc, a, p, fastmathAttr);6556 mlir::Type intType = builder.getIntegerType(6557 a.getType().getIntOrFloatBitWidth(), /*signed=*/true);6558 mlir::Value intResult = builder.createConvert(loc, intType, divResult);6559 mlir::Value cnvResult = builder.createConvert(loc, a.getType(), intResult);6560 mlir::Value mulResult =6561 mlir::arith::MulFOp::create(builder, loc, cnvResult, p, fastmathAttr);6562 mlir::Value subResult =6563 mlir::arith::SubFOp::create(builder, loc, a, mulResult, fastmathAttr);6564 return subResult;6565}6566 6567mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,6568 llvm::ArrayRef<mlir::Value> args) {6569 auto mod = builder.getModule();6570 bool useFastRealMod = false;6571 if (auto attr = mod->getAttrOfType<mlir::BoolAttr>("fir.fast_real_mod"))6572 useFastRealMod = attr.getValue();6573 6574 assert(args.size() == 2);6575 if (resultType.isUnsignedInteger()) {6576 mlir::Type signlessType = mlir::IntegerType::get(6577 builder.getContext(), resultType.getIntOrFloatBitWidth(),6578 mlir::IntegerType::SignednessSemantics::Signless);6579 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,6580 args[0], args[1]);6581 }6582 if (mlir::isa<mlir::IntegerType>(resultType))6583 return mlir::arith::RemSIOp::create(builder, loc, args[0], args[1]);6584 6585 if (resultType.isFloat() && useFastRealMod) {6586 // Treat MOD as an approximate function and code-gen inline code6587 // instead of calling into the Fortran runtime library.6588 return builder.createConvert(loc, resultType,6589 genFastMod(builder, loc, args[0], args[1]));6590 } else {6591 // Use runtime.6592 return builder.createConvert(6593 loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1]));6594 }6595}6596 6597// MODULO6598mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,6599 llvm::ArrayRef<mlir::Value> args) {6600 // TODO: we'd better generate a runtime call here, when runtime error6601 // checking is needed (to detect 0 divisor) or when precise math is requested.6602 assert(args.size() == 2);6603 // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.6604 // In the meantime, use a simple inlined implementation based on truncated6605 // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual6606 // division and multiplication from MODULO formula.6607 // - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.6608 // - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =6609 // A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P6610 // Note that A/P < 0 if and only if A and P signs are different.6611 if (resultType.isUnsignedInteger()) {6612 mlir::Type signlessType = mlir::IntegerType::get(6613 builder.getContext(), resultType.getIntOrFloatBitWidth(),6614 mlir::IntegerType::SignednessSemantics::Signless);6615 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,6616 args[0], args[1]);6617 }6618 if (mlir::isa<mlir::IntegerType>(resultType)) {6619 auto remainder =6620 mlir::arith::RemSIOp::create(builder, loc, args[0], args[1]);6621 auto argXor = mlir::arith::XOrIOp::create(builder, loc, args[0], args[1]);6622 mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);6623 auto argSignDifferent = mlir::arith::CmpIOp::create(6624 builder, loc, mlir::arith::CmpIPredicate::slt, argXor, zero);6625 auto remainderIsNotZero = mlir::arith::CmpIOp::create(6626 builder, loc, mlir::arith::CmpIPredicate::ne, remainder, zero);6627 auto mustAddP = mlir::arith::AndIOp::create(6628 builder, loc, remainderIsNotZero, argSignDifferent);6629 auto remPlusP =6630 mlir::arith::AddIOp::create(builder, loc, remainder, args[1]);6631 return mlir::arith::SelectOp::create(builder, loc, mustAddP, remPlusP,6632 remainder);6633 }6634 6635 auto fastMathFlags = builder.getFastMathFlags();6636 // F128 arith::RemFOp may be lowered to a runtime call that may be unsupported6637 // on the target, so generate a call to Fortran Runtime's ModuloReal16.6638 if (resultType == mlir::Float128Type::get(builder.getContext()) ||6639 (fastMathFlags & mlir::arith::FastMathFlags::ninf) ==6640 mlir::arith::FastMathFlags::none)6641 return builder.createConvert(6642 loc, resultType,6643 fir::runtime::genModulo(builder, loc, args[0], args[1]));6644 6645 auto remainder = mlir::arith::RemFOp::create(builder, loc, args[0], args[1]);6646 mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());6647 auto remainderIsNotZero = mlir::arith::CmpFOp::create(6648 builder, loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);6649 auto aLessThanZero = mlir::arith::CmpFOp::create(6650 builder, loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);6651 auto pLessThanZero = mlir::arith::CmpFOp::create(6652 builder, loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);6653 auto argSignDifferent =6654 mlir::arith::XOrIOp::create(builder, loc, aLessThanZero, pLessThanZero);6655 auto mustAddP = mlir::arith::AndIOp::create(builder, loc, remainderIsNotZero,6656 argSignDifferent);6657 auto remPlusP = mlir::arith::AddFOp::create(builder, loc, remainder, args[1]);6658 return mlir::arith::SelectOp::create(builder, loc, mustAddP, remPlusP,6659 remainder);6660}6661 6662void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue> args) {6663 assert(args.size() == 4);6664 6665 const fir::ExtendedValue &from = args[0];6666 const fir::ExtendedValue &to = args[1];6667 const fir::ExtendedValue &status = args[2];6668 const fir::ExtendedValue &errMsg = args[3];6669 6670 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());6671 mlir::Value errBox =6672 isStaticallyPresent(errMsg)6673 ? fir::getBase(errMsg)6674 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();6675 6676 const fir::MutableBoxValue *fromBox = from.getBoxOf<fir::MutableBoxValue>();6677 const fir::MutableBoxValue *toBox = to.getBoxOf<fir::MutableBoxValue>();6678 6679 assert(fromBox && toBox && "move_alloc parameters must be mutable arrays");6680 6681 mlir::Value fromAddr = fir::factory::getMutableIRBox(builder, loc, *fromBox);6682 mlir::Value toAddr = fir::factory::getMutableIRBox(builder, loc, *toBox);6683 6684 mlir::Value hasStat = builder.createBool(loc, isStaticallyPresent(status));6685 6686 mlir::Value stat = fir::runtime::genMoveAlloc(builder, loc, toAddr, fromAddr,6687 hasStat, errBox);6688 6689 fir::factory::syncMutableBoxFromIRBox(builder, loc, *fromBox);6690 fir::factory::syncMutableBoxFromIRBox(builder, loc, *toBox);6691 6692 if (isStaticallyPresent(status)) {6693 mlir::Value statAddr = fir::getBase(status);6694 mlir::Value statIsPresentAtRuntime =6695 builder.genIsNotNullAddr(loc, statAddr);6696 builder.genIfThen(loc, statIsPresentAtRuntime)6697 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })6698 .end();6699 }6700}6701 6702// MVBITS6703void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {6704 // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:6705 // FROMPOS >= 06706 // LEN >= 06707 // TOPOS >= 06708 // FROMPOS + LEN <= BIT_SIZE(FROM)6709 // TOPOS + LEN <= BIT_SIZE(TO)6710 // MASK = -1 >> (BIT_SIZE(FROM) - LEN)6711 // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |6712 // (((FROM >> FROMPOS) & MASK) << TOPOS)6713 assert(args.size() == 5);6714 auto unbox = [&](fir::ExtendedValue exv) {6715 const mlir::Value *arg = exv.getUnboxed();6716 assert(arg && "nonscalar mvbits argument");6717 return *arg;6718 };6719 mlir::Value from = unbox(args[0]);6720 mlir::Type fromType = from.getType();6721 mlir::Type signlessType = mlir::IntegerType::get(6722 builder.getContext(), fromType.getIntOrFloatBitWidth(),6723 mlir::IntegerType::SignednessSemantics::Signless);6724 mlir::Value frompos =6725 builder.createConvert(loc, signlessType, unbox(args[1]));6726 mlir::Value len = builder.createConvert(loc, signlessType, unbox(args[2]));6727 mlir::Value toAddr = unbox(args[3]);6728 mlir::Type toType{fir::dyn_cast_ptrEleTy(toAddr.getType())};6729 assert(toType.getIntOrFloatBitWidth() == fromType.getIntOrFloatBitWidth() &&6730 "mismatched mvbits types");6731 auto to = fir::LoadOp::create(builder, loc, signlessType, toAddr);6732 mlir::Value topos = builder.createConvert(loc, signlessType, unbox(args[4]));6733 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);6734 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);6735 mlir::Value bitSize = builder.createIntegerConstant(6736 loc, signlessType,6737 mlir::cast<mlir::IntegerType>(signlessType).getWidth());6738 auto shiftCount = mlir::arith::SubIOp::create(builder, loc, bitSize, len);6739 auto mask = mlir::arith::ShRUIOp::create(builder, loc, ones, shiftCount);6740 auto unchangedTmp1 = mlir::arith::ShLIOp::create(builder, loc, mask, topos);6741 auto unchangedTmp2 =6742 mlir::arith::XOrIOp::create(builder, loc, unchangedTmp1, ones);6743 auto unchanged = mlir::arith::AndIOp::create(builder, loc, unchangedTmp2, to);6744 if (fromType.isUnsignedInteger())6745 from = builder.createConvert(loc, signlessType, from);6746 auto frombitsTmp1 = mlir::arith::ShRUIOp::create(builder, loc, from, frompos);6747 auto frombitsTmp2 =6748 mlir::arith::AndIOp::create(builder, loc, frombitsTmp1, mask);6749 auto frombits =6750 mlir::arith::ShLIOp::create(builder, loc, frombitsTmp2, topos);6751 auto resTmp = mlir::arith::OrIOp::create(builder, loc, unchanged, frombits);6752 auto lenIsZero = mlir::arith::CmpIOp::create(6753 builder, loc, mlir::arith::CmpIPredicate::eq, len, zero);6754 mlir::Value res =6755 mlir::arith::SelectOp::create(builder, loc, lenIsZero, to, resTmp);6756 if (toType.isUnsignedInteger())6757 res = builder.createConvert(loc, toType, res);6758 fir::StoreOp::create(builder, loc, res, toAddr);6759}6760 6761// NEAREST, IEEE_NEXT_AFTER, IEEE_NEXT_DOWN, IEEE_NEXT_UP6762template <I::NearestProc proc>6763mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,6764 llvm::ArrayRef<mlir::Value> args) {6765 // NEAREST6766 // Return the number adjacent to arg X in the direction of the infinity6767 // with the sign of arg S. Terminate with an error if arg S is zero.6768 // Generate exceptions as for IEEE_NEXT_AFTER.6769 // IEEE_NEXT_AFTER6770 // Return isNan(Y) ? NaN : X==Y ? X : num adjacent to X in the dir of Y.6771 // Signal IEEE_OVERFLOW, IEEE_INEXACT for finite X and infinite result.6772 // Signal IEEE_UNDERFLOW, IEEE_INEXACT for subnormal result.6773 // IEEE_NEXT_DOWN6774 // Return the number adjacent to X and less than X.6775 // Signal IEEE_INVALID when X is a signaling NaN.6776 // IEEE_NEXT_UP6777 // Return the number adjacent to X and greater than X.6778 // Signal IEEE_INVALID when X is a signaling NaN.6779 //6780 // valueUp -- true if a finite result must be larger than X.6781 // magnitudeUp -- true if a finite abs(result) must be larger than abs(X).6782 //6783 // if (isNextAfter && isNan(Y)) X = NaN // result = NaN6784 // if (isNan(X) || (isNextAfter && X == Y) || (isInfinite(X) && magnitudeUp))6785 // result = X6786 // else if (isZero(X))6787 // result = valueUp ? minPositiveSubnormal : minNegativeSubnormal6788 // else6789 // result = magUp ? (X + minPositiveSubnormal) : (X - minPositiveSubnormal)6790 6791 assert(args.size() == 1 || args.size() == 2);6792 mlir::Value x = args[0];6793 mlir::FloatType xType = mlir::dyn_cast<mlir::FloatType>(x.getType());6794 const unsigned xBitWidth = xType.getWidth();6795 mlir::Type i1Ty = builder.getI1Type();6796 if constexpr (proc == NearestProc::NextAfter) {6797 // If isNan(Y), set X to a qNaN that will propagate to the resultIsX result.6798 mlir::Value qNan = genQNan(xType);6799 mlir::Value isFPClass = genIsFPClass(i1Ty, args[1], nanTest);6800 x = mlir::arith::SelectOp::create(builder, loc, isFPClass, qNan, x);6801 }6802 mlir::Value resultIsX = genIsFPClass(i1Ty, x, nanTest);6803 mlir::Type intType = builder.getIntegerType(xBitWidth);6804 mlir::Value one = builder.createIntegerConstant(loc, intType, 1);6805 6806 // Set valueUp to true if a finite result must be larger than arg X.6807 mlir::Value valueUp;6808 if constexpr (proc == NearestProc::Nearest) {6809 // Arg S must not be zero.6810 fir::IfOp ifOp =6811 fir::IfOp::create(builder, loc, genIsFPClass(i1Ty, args[1], zeroTest),6812 /*withElseRegion=*/false);6813 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());6814 fir::runtime::genReportFatalUserError(6815 builder, loc, "intrinsic nearest S argument is zero");6816 builder.setInsertionPointAfter(ifOp);6817 mlir::Value sSign = IntrinsicLibrary::genIeeeSignbit(intType, {args[1]});6818 valueUp = mlir::arith::CmpIOp::create(6819 builder, loc, mlir::arith::CmpIPredicate::ne, sSign, one);6820 } else if constexpr (proc == NearestProc::NextAfter) {6821 // Convert X and Y to a common type to allow comparison. Direct conversions6822 // between kinds 2, 3, 10, and 16 are not all supported. These conversions6823 // are implemented by converting kind=2,3 values to kind=4, possibly6824 // followed with a conversion of that value to a larger type.6825 mlir::Value x1 = x;6826 mlir::Value y = args[1];6827 mlir::FloatType yType = mlir::dyn_cast<mlir::FloatType>(args[1].getType());6828 const unsigned yBitWidth = yType.getWidth();6829 if (xType != yType) {6830 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());6831 if (xBitWidth < 32)6832 x1 = builder.createConvert(loc, f32Ty, x1);6833 if (yBitWidth > 32 && yBitWidth > xBitWidth)6834 x1 = builder.createConvert(loc, yType, x1);6835 if (yBitWidth < 32)6836 y = builder.createConvert(loc, f32Ty, y);6837 if (xBitWidth > 32 && xBitWidth > yBitWidth)6838 y = builder.createConvert(loc, xType, y);6839 }6840 resultIsX = mlir::arith::OrIOp::create(6841 builder, loc, resultIsX,6842 mlir::arith::CmpFOp::create(builder, loc,6843 mlir::arith::CmpFPredicate::OEQ, x1, y));6844 valueUp = mlir::arith::CmpFOp::create(6845 builder, loc, mlir::arith::CmpFPredicate::OLT, x1, y);6846 } else if constexpr (proc == NearestProc::NextDown) {6847 valueUp = builder.createBool(loc, false);6848 } else if constexpr (proc == NearestProc::NextUp) {6849 valueUp = builder.createBool(loc, true);6850 }6851 mlir::Value magnitudeUp = mlir::arith::CmpIOp::create(6852 builder, loc, mlir::arith::CmpIPredicate::ne, valueUp,6853 IntrinsicLibrary::genIeeeSignbit(i1Ty, {args[0]}));6854 resultIsX = mlir::arith::OrIOp::create(6855 builder, loc, resultIsX,6856 mlir::arith::AndIOp::create(6857 builder, loc, genIsFPClass(i1Ty, x, infiniteTest), magnitudeUp));6858 6859 // Result is X. (For ieee_next_after with isNan(Y), X has been set to a NaN.)6860 fir::IfOp outerIfOp = fir::IfOp::create(builder, loc, resultType, resultIsX,6861 /*withElseRegion=*/true);6862 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());6863 if constexpr (proc == NearestProc::NextDown || proc == NearestProc::NextUp)6864 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID,6865 genIsFPClass(i1Ty, x, snanTest));6866 fir::ResultOp::create(builder, loc, x);6867 6868 // Result is minPositiveSubnormal or minNegativeSubnormal. (X is zero.)6869 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());6870 mlir::Value resultIsMinSubnormal = mlir::arith::CmpFOp::create(6871 builder, loc, mlir::arith::CmpFPredicate::OEQ, x,6872 builder.createRealZeroConstant(loc, xType));6873 fir::IfOp innerIfOp =6874 fir::IfOp::create(builder, loc, resultType, resultIsMinSubnormal,6875 /*withElseRegion=*/true);6876 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());6877 mlir::Value minPositiveSubnormal =6878 mlir::arith::BitcastOp::create(builder, loc, resultType, one);6879 mlir::Value minNegativeSubnormal = mlir::arith::BitcastOp::create(6880 builder, loc, resultType,6881 mlir::arith::ConstantOp::create(6882 builder, loc, intType,6883 builder.getIntegerAttr(6884 intType, llvm::APInt::getBitsSetWithWrap(6885 xBitWidth, /*lo=*/xBitWidth - 1, /*hi=*/1))));6886 mlir::Value result = mlir::arith::SelectOp::create(6887 builder, loc, valueUp, minPositiveSubnormal, minNegativeSubnormal);6888 if constexpr (proc == NearestProc::Nearest || proc == NearestProc::NextAfter)6889 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |6890 _FORTRAN_RUNTIME_IEEE_INEXACT);6891 fir::ResultOp::create(builder, loc, result);6892 6893 // Result is (X + minPositiveSubnormal) or (X - minPositiveSubnormal).6894 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());6895 if (xBitWidth == 80) {6896 // Kind 10. Call std::nextafter, which generates exceptions as required6897 // for ieee_next_after and nearest. Override this exception processing6898 // for ieee_next_down and ieee_next_up.6899 constexpr bool overrideExceptionGeneration =6900 proc == NearestProc::NextDown || proc == NearestProc::NextUp;6901 [[maybe_unused]] mlir::Type i32Ty;6902 [[maybe_unused]] mlir::Value allExcepts, excepts, mask;6903 if constexpr (overrideExceptionGeneration) {6904 i32Ty = builder.getIntegerType(32);6905 allExcepts = fir::runtime::genMapExcept(6906 builder, loc,6907 builder.createIntegerConstant(loc, i32Ty, _FORTRAN_RUNTIME_IEEE_ALL));6908 excepts = genRuntimeCall("fetestexcept", i32Ty, allExcepts);6909 mask = genRuntimeCall("fedisableexcept", i32Ty, allExcepts);6910 }6911 result = fir::runtime::genNearest(builder, loc, x, valueUp);6912 if constexpr (overrideExceptionGeneration) {6913 genRuntimeCall("feclearexcept", i32Ty, allExcepts);6914 genRuntimeCall("feraiseexcept", i32Ty, excepts);6915 genRuntimeCall("feenableexcept", i32Ty, mask);6916 }6917 fir::ResultOp::create(builder, loc, result);6918 } else {6919 // Kind 2, 3, 4, 8, 16. Increment or decrement X cast to integer.6920 mlir::Value intX = mlir::arith::BitcastOp::create(builder, loc, intType, x);6921 mlir::Value add = mlir::arith::AddIOp::create(builder, loc, intX, one);6922 mlir::Value sub = mlir::arith::SubIOp::create(builder, loc, intX, one);6923 result = mlir::arith::BitcastOp::create(6924 builder, loc, resultType,6925 mlir::arith::SelectOp::create(builder, loc, magnitudeUp, add, sub));6926 if constexpr (proc == NearestProc::Nearest ||6927 proc == NearestProc::NextAfter) {6928 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |6929 _FORTRAN_RUNTIME_IEEE_INEXACT,6930 genIsFPClass(i1Ty, result, infiniteTest));6931 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |6932 _FORTRAN_RUNTIME_IEEE_INEXACT,6933 genIsFPClass(i1Ty, result, subnormalTest));6934 }6935 fir::ResultOp::create(builder, loc, result);6936 }6937 6938 builder.setInsertionPointAfter(innerIfOp);6939 fir::ResultOp::create(builder, loc, innerIfOp.getResult(0));6940 builder.setInsertionPointAfter(outerIfOp);6941 return outerIfOp.getResult(0);6942}6943 6944// NINT6945mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,6946 llvm::ArrayRef<mlir::Value> args) {6947 assert(args.size() >= 1);6948 // Skip optional kind argument to search the runtime; it is already reflected6949 // in result type.6950 return genRuntimeCall("nint", resultType, {args[0]});6951}6952 6953// NORM26954fir::ExtendedValue6955IntrinsicLibrary::genNorm2(mlir::Type resultType,6956 llvm::ArrayRef<fir::ExtendedValue> args) {6957 assert(args.size() == 2);6958 6959 // Handle required array argument6960 mlir::Value array = builder.createBox(loc, args[0]);6961 unsigned rank = fir::BoxValue(array).rank();6962 assert(rank >= 1);6963 6964 // Check if the dim argument is present6965 bool absentDim = isStaticallyAbsent(args[1]);6966 6967 // If dim argument is absent or the array is rank 1, then the result is6968 // a scalar (since the the result is rank-1 or 0). Otherwise, the result is6969 // an array.6970 if (absentDim || rank == 1) {6971 return fir::runtime::genNorm2(builder, loc, array);6972 } else {6973 // Create mutable fir.box to be passed to the runtime for the result.6974 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);6975 fir::MutableBoxValue resultMutableBox =6976 fir::factory::createTempMutableBox(builder, loc, resultArrayType);6977 mlir::Value resultIrBox =6978 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);6979 6980 mlir::Value dim = fir::getBase(args[1]);6981 fir::runtime::genNorm2Dim(builder, loc, resultIrBox, array, dim);6982 // Handle cleanup of allocatable result descriptor and return6983 return readAndAddCleanUp(resultMutableBox, resultType, "NORM2");6984 }6985}6986 6987// NOT6988mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,6989 llvm::ArrayRef<mlir::Value> args) {6990 assert(args.size() == 1);6991 mlir::Type signlessType = mlir::IntegerType::get(6992 builder.getContext(), resultType.getIntOrFloatBitWidth(),6993 mlir::IntegerType::SignednessSemantics::Signless);6994 mlir::Value allOnes = builder.createAllOnesInteger(loc, signlessType);6995 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],6996 allOnes);6997}6998 6999// NULL7000fir::ExtendedValue7001IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {7002 // NULL() without MOLD must be handled in the contexts where it can appear7003 // (see table 16.5 of Fortran 2018 standard).7004 assert(args.size() == 1 && isStaticallyPresent(args[0]) &&7005 "MOLD argument required to lower NULL outside of any context");7006 mlir::Type ptrTy = fir::getBase(args[0]).getType();7007 if (ptrTy && fir::isBoxProcAddressType(ptrTy)) {7008 auto boxProcType = mlir::cast<fir::BoxProcType>(fir::unwrapRefType(ptrTy));7009 mlir::Value boxStorage = builder.createTemporary(loc, boxProcType);7010 mlir::Value nullBoxProc =7011 fir::factory::createNullBoxProc(builder, loc, boxProcType);7012 builder.createStoreWithConvert(loc, nullBoxProc, boxStorage);7013 return boxStorage;7014 }7015 const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();7016 assert(mold && "MOLD must be a pointer or allocatable");7017 fir::BaseBoxType boxType = mold->getBoxTy();7018 mlir::Value boxStorage = builder.createTemporary(loc, boxType);7019 mlir::Value box = fir::factory::createUnallocatedBox(7020 builder, loc, boxType, mold->nonDeferredLenParams());7021 fir::StoreOp::create(builder, loc, box, boxStorage);7022 return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});7023}7024 7025// NUM_IMAGES7026fir::ExtendedValue7027IntrinsicLibrary::genNumImages(mlir::Type resultType,7028 llvm::ArrayRef<fir::ExtendedValue> args) {7029 converter->checkCoarrayEnabled();7030 assert(args.size() == 0 || args.size() == 1);7031 7032 if (args.size())7033 return mif::NumImagesOp::create(builder, loc, fir::getBase(args[0]))7034 .getResult();7035 return mif::NumImagesOp::create(builder, loc).getResult();7036}7037 7038// PACK7039fir::ExtendedValue7040IntrinsicLibrary::genPack(mlir::Type resultType,7041 llvm::ArrayRef<fir::ExtendedValue> args) {7042 [[maybe_unused]] auto numArgs = args.size();7043 assert(numArgs == 2 || numArgs == 3);7044 7045 // Handle required array argument7046 mlir::Value array = builder.createBox(loc, args[0]);7047 7048 // Handle required mask argument7049 mlir::Value mask = builder.createBox(loc, args[1]);7050 7051 // Handle optional vector argument7052 mlir::Value vector =7053 isStaticallyAbsent(args, 2)7054 ? fir::AbsentOp::create(builder, loc,7055 fir::BoxType::get(builder.getI1Type()))7056 : builder.createBox(loc, args[2]);7057 7058 // Create mutable fir.box to be passed to the runtime for the result.7059 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);7060 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(7061 builder, loc, resultArrayType, {},7062 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});7063 mlir::Value resultIrBox =7064 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7065 7066 fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);7067 7068 return readAndAddCleanUp(resultMutableBox, resultType, "PACK");7069}7070 7071// PARITY7072fir::ExtendedValue7073IntrinsicLibrary::genParity(mlir::Type resultType,7074 llvm::ArrayRef<fir::ExtendedValue> args) {7075 7076 assert(args.size() == 2);7077 // Handle required mask argument7078 mlir::Value mask = builder.createBox(loc, args[0]);7079 7080 fir::BoxValue maskArry = builder.createBox(loc, args[0]);7081 int rank = maskArry.rank();7082 assert(rank >= 1);7083 7084 // Handle optional dim argument7085 bool absentDim = isStaticallyAbsent(args[1]);7086 mlir::Value dim =7087 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)7088 : fir::getBase(args[1]);7089 7090 if (rank == 1 || absentDim)7091 return builder.createConvert(7092 loc, resultType, fir::runtime::genParity(builder, loc, mask, dim));7093 7094 // else use the result descriptor ParityDim() intrinsic7095 7096 // Create mutable fir.box to be passed to the runtime for the result.7097 7098 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);7099 fir::MutableBoxValue resultMutableBox =7100 fir::factory::createTempMutableBox(builder, loc, resultArrayType);7101 mlir::Value resultIrBox =7102 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7103 7104 // Call runtime. The runtime is allocating the result.7105 fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim);7106 return readAndAddCleanUp(resultMutableBox, resultType, "PARITY");7107}7108 7109// PERROR7110void IntrinsicLibrary::genPerror(llvm::ArrayRef<fir::ExtendedValue> args) {7111 assert(args.size() == 1);7112 7113 fir::ExtendedValue str = args[0];7114 const auto *box = str.getBoxOf<fir::BoxValue>();7115 mlir::Value addr =7116 fir::BoxAddrOp::create(builder, loc, box->getMemTy(), fir::getBase(*box));7117 fir::runtime::genPerror(builder, loc, addr);7118}7119 7120// POPCNT7121mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,7122 llvm::ArrayRef<mlir::Value> args) {7123 assert(args.size() == 1);7124 7125 mlir::Value count = mlir::math::CtPopOp::create(builder, loc, args);7126 7127 return builder.createConvert(loc, resultType, count);7128}7129 7130// POPPAR7131mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,7132 llvm::ArrayRef<mlir::Value> args) {7133 assert(args.size() == 1);7134 7135 mlir::Value count = genPopcnt(resultType, args);7136 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);7137 7138 return mlir::arith::AndIOp::create(builder, loc, count, one);7139}7140 7141// PRESENT7142fir::ExtendedValue7143IntrinsicLibrary::genPresent(mlir::Type,7144 llvm::ArrayRef<fir::ExtendedValue> args) {7145 assert(args.size() == 1);7146 return fir::IsPresentOp::create(builder, loc, builder.getI1Type(),7147 fir::getBase(args[0]));7148}7149 7150// PRODUCT7151fir::ExtendedValue7152IntrinsicLibrary::genProduct(mlir::Type resultType,7153 llvm::ArrayRef<fir::ExtendedValue> args) {7154 return genReduction(fir::runtime::genProduct, fir::runtime::genProductDim,7155 "PRODUCT", resultType, args);7156}7157 7158// PUTENV7159fir::ExtendedValue7160IntrinsicLibrary::genPutenv(std::optional<mlir::Type> resultType,7161 llvm::ArrayRef<fir::ExtendedValue> args) {7162 assert((resultType.has_value() && args.size() == 1) ||7163 (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));7164 7165 mlir::Value str = fir::getBase(args[0]);7166 mlir::Value strLength = fir::getLen(args[0]);7167 mlir::Value statusValue =7168 fir::runtime::genPutEnv(builder, loc, str, strLength);7169 7170 if (resultType.has_value()) {7171 // Function form, return status.7172 return builder.createConvert(loc, *resultType, statusValue);7173 }7174 7175 // Subroutine form, store status and return none.7176 const fir::ExtendedValue &status = args[1];7177 if (!isStaticallyAbsent(status)) {7178 mlir::Value statusAddr = fir::getBase(status);7179 mlir::Value statusIsPresentAtRuntime =7180 builder.genIsNotNullAddr(loc, statusAddr);7181 builder.genIfThen(loc, statusIsPresentAtRuntime)7182 .genThen([&]() {7183 builder.createStoreWithConvert(loc, statusValue, statusAddr);7184 })7185 .end();7186 }7187 7188 return {};7189}7190 7191// RANDOM_INIT7192void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {7193 assert(args.size() == 2);7194 fir::runtime::genRandomInit(builder, loc, fir::getBase(args[0]),7195 fir::getBase(args[1]));7196}7197 7198// RANDOM_NUMBER7199void IntrinsicLibrary::genRandomNumber(7200 llvm::ArrayRef<fir::ExtendedValue> args) {7201 assert(args.size() == 1);7202 fir::runtime::genRandomNumber(builder, loc, fir::getBase(args[0]));7203}7204 7205// RANDOM_SEED7206void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {7207 assert(args.size() == 3);7208 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());7209 auto getDesc = [&](int i) {7210 return isStaticallyPresent(args[i])7211 ? fir::getBase(args[i])7212 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();7213 };7214 mlir::Value size = getDesc(0);7215 mlir::Value put = getDesc(1);7216 mlir::Value get = getDesc(2);7217 fir::runtime::genRandomSeed(builder, loc, size, put, get);7218}7219 7220// REDUCE7221fir::ExtendedValue7222IntrinsicLibrary::genReduce(mlir::Type resultType,7223 llvm::ArrayRef<fir::ExtendedValue> args) {7224 assert(args.size() == 6);7225 7226 fir::BoxValue arrayTmp = builder.createBox(loc, args[0]);7227 mlir::Value array = fir::getBase(arrayTmp);7228 mlir::Value operation = fir::getBase(args[1]);7229 int rank = arrayTmp.rank();7230 assert(rank >= 1);7231 7232 // Arguements to the reduction operation are passed by reference or value?7233 bool argByRef = true;7234 if (!operation.getDefiningOp())7235 TODO(loc, "Distinguigh dummy procedure arguments");7236 if (auto embox =7237 mlir::dyn_cast_or_null<fir::EmboxProcOp>(operation.getDefiningOp())) {7238 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(embox.getFunc().getType());7239 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));7240 } else if (auto load = mlir::dyn_cast_or_null<fir::LoadOp>(7241 operation.getDefiningOp())) {7242 auto boxProcTy = mlir::dyn_cast_or_null<fir::BoxProcType>(load.getType());7243 assert(boxProcTy && "expect BoxProcType");7244 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(boxProcTy.getEleTy());7245 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));7246 }7247 7248 mlir::Type ty = array.getType();7249 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);7250 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType();7251 7252 // Handle optional arguments7253 bool absentDim = isStaticallyAbsent(args[2]);7254 7255 auto mask = isStaticallyAbsent(args[3])7256 ? fir::AbsentOp::create(7257 builder, loc, fir::BoxType::get(builder.getI1Type()))7258 : builder.createBox(loc, args[3]);7259 7260 mlir::Value identity =7261 isStaticallyAbsent(args[4])7262 ? fir::AbsentOp::create(builder, loc, fir::ReferenceType::get(eleTy))7263 : fir::getBase(args[4]);7264 7265 mlir::Value ordered = isStaticallyAbsent(args[5])7266 ? builder.createBool(loc, false)7267 : fir::getBase(args[5]);7268 7269 // We call the type specific versions because the result is scalar7270 // in the case below.7271 if (absentDim || rank == 1) {7272 if (fir::isa_complex(eleTy) || fir::isa_derived(eleTy)) {7273 mlir::Value result = builder.createTemporary(loc, eleTy);7274 fir::runtime::genReduce(builder, loc, array, operation, mask, identity,7275 ordered, result, argByRef);7276 if (fir::isa_derived(eleTy))7277 return result;7278 return fir::LoadOp::create(builder, loc, result);7279 }7280 if (fir::isa_char(eleTy)) {7281 auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(resultType);7282 assert(charTy && "expect CharacterType");7283 fir::factory::CharacterExprHelper charHelper(builder, loc);7284 mlir::Value len;7285 if (charTy.hasDynamicLen())7286 len = charHelper.readLengthFromBox(fir::getBase(arrayTmp), charTy);7287 else7288 len = builder.createIntegerConstant(loc, builder.getI32Type(),7289 charTy.getLen());7290 fir::CharBoxValue temp = charHelper.createCharacterTemp(eleTy, len);7291 fir::runtime::genReduce(builder, loc, array, operation, mask, identity,7292 ordered, temp.getBuffer(), argByRef);7293 return temp;7294 }7295 return fir::runtime::genReduce(builder, loc, array, operation, mask,7296 identity, ordered, argByRef);7297 }7298 // Handle cases that have an array result.7299 // Create mutable fir.box to be passed to the runtime for the result.7300 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);7301 fir::MutableBoxValue resultMutableBox =7302 fir::factory::createTempMutableBox(builder, loc, resultArrayType);7303 mlir::Value resultIrBox =7304 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7305 mlir::Value dim = fir::getBase(args[2]);7306 fir::runtime::genReduceDim(builder, loc, array, operation, dim, mask,7307 identity, ordered, resultIrBox, argByRef);7308 return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");7309}7310 7311// RENAME7312fir::ExtendedValue7313IntrinsicLibrary::genRename(std::optional<mlir::Type> resultType,7314 mlir::ArrayRef<fir::ExtendedValue> args) {7315 assert((args.size() == 3 && !resultType.has_value()) ||7316 (args.size() == 2 && resultType.has_value()));7317 7318 mlir::Value path1 = fir::getBase(args[0]);7319 mlir::Value path2 = fir::getBase(args[1]);7320 if (!path1 || !path2)7321 fir::emitFatalError(loc, "Expected at least two dummy arguments");7322 7323 if (resultType.has_value()) {7324 // code-gen for the function form of RENAME7325 auto statusAddr = builder.createTemporary(loc, *resultType);7326 auto statusBox = builder.createBox(loc, statusAddr);7327 fir::runtime::genRename(builder, loc, path1, path2, statusBox);7328 return fir::LoadOp::create(builder, loc, statusAddr);7329 } else {7330 // code-gen for the procedure form of RENAME7331 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());7332 auto status = args[2];7333 mlir::Value statusBox =7334 isStaticallyPresent(status)7335 ? fir::getBase(status)7336 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();7337 fir::runtime::genRename(builder, loc, path1, path2, statusBox);7338 return {};7339 }7340}7341 7342// REPEAT7343fir::ExtendedValue7344IntrinsicLibrary::genRepeat(mlir::Type resultType,7345 llvm::ArrayRef<fir::ExtendedValue> args) {7346 assert(args.size() == 2);7347 mlir::Value string = builder.createBox(loc, args[0]);7348 mlir::Value ncopies = fir::getBase(args[1]);7349 // Create mutable fir.box to be passed to the runtime for the result.7350 fir::MutableBoxValue resultMutableBox =7351 fir::factory::createTempMutableBox(builder, loc, resultType);7352 mlir::Value resultIrBox =7353 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7354 // Call runtime. The runtime is allocating the result.7355 fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);7356 // Read result from mutable fir.box and add it to the list of temps to be7357 // finalized by the StatementContext.7358 return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");7359}7360 7361// RESHAPE7362fir::ExtendedValue7363IntrinsicLibrary::genReshape(mlir::Type resultType,7364 llvm::ArrayRef<fir::ExtendedValue> args) {7365 assert(args.size() == 4);7366 7367 // Handle source argument7368 mlir::Value source = builder.createBox(loc, args[0]);7369 7370 // Handle shape argument7371 mlir::Value shape = builder.createBox(loc, args[1]);7372 assert(fir::BoxValue(shape).rank() == 1);7373 mlir::Type shapeTy = shape.getType();7374 mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);7375 auto resultRank = mlir::cast<fir::SequenceType>(shapeArrTy).getShape()[0];7376 7377 if (resultRank == fir::SequenceType::getUnknownExtent())7378 TODO(loc, "intrinsic: reshape requires computing rank of result");7379 7380 // Handle optional pad argument7381 mlir::Value pad =7382 isStaticallyAbsent(args[2])7383 ? fir::AbsentOp::create(builder, loc,7384 fir::BoxType::get(builder.getI1Type()))7385 : builder.createBox(loc, args[2]);7386 7387 // Handle optional order argument7388 mlir::Value order =7389 isStaticallyAbsent(args[3])7390 ? fir::AbsentOp::create(builder, loc,7391 fir::BoxType::get(builder.getI1Type()))7392 : builder.createBox(loc, args[3]);7393 7394 // Create mutable fir.box to be passed to the runtime for the result.7395 mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);7396 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(7397 builder, loc, type, {},7398 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});7399 7400 mlir::Value resultIrBox =7401 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7402 7403 fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,7404 order);7405 7406 return readAndAddCleanUp(resultMutableBox, resultType, "RESHAPE");7407}7408 7409// RRSPACING7410mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,7411 llvm::ArrayRef<mlir::Value> args) {7412 assert(args.size() == 1);7413 7414 return builder.createConvert(7415 loc, resultType,7416 fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));7417}7418 7419// ERFC_SCALED7420mlir::Value IntrinsicLibrary::genErfcScaled(mlir::Type resultType,7421 llvm::ArrayRef<mlir::Value> args) {7422 assert(args.size() == 1);7423 7424 return builder.createConvert(7425 loc, resultType,7426 fir::runtime::genErfcScaled(builder, loc, fir::getBase(args[0])));7427}7428 7429// SAME_TYPE_AS7430fir::ExtendedValue7431IntrinsicLibrary::genSameTypeAs(mlir::Type resultType,7432 llvm::ArrayRef<fir::ExtendedValue> args) {7433 assert(args.size() == 2);7434 7435 return builder.createConvert(7436 loc, resultType,7437 fir::runtime::genSameTypeAs(builder, loc, fir::getBase(args[0]),7438 fir::getBase(args[1])));7439}7440 7441// SCALE7442mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,7443 llvm::ArrayRef<mlir::Value> args) {7444 assert(args.size() == 2);7445 mlir::FloatType floatTy = mlir::dyn_cast<mlir::FloatType>(resultType);7446 if (!floatTy.isF16() && !floatTy.isBF16()) // kind=4,8,10,167447 return builder.createConvert(7448 loc, resultType,7449 fir::runtime::genScale(builder, loc, args[0], args[1]));7450 7451 // Convert kind=2,3 arg X to kind=4. Convert kind=4 result back to kind=2,3.7452 mlir::Type i1Ty = builder.getI1Type();7453 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());7454 mlir::Value result = builder.createConvert(7455 loc, resultType,7456 fir::runtime::genScale(7457 builder, loc, builder.createConvert(loc, f32Ty, args[0]), args[1]));7458 7459 // kind=4 runtime::genScale call may not signal kind=2,3 exceptions.7460 // If X is finite and result is infinite, signal IEEE_OVERFLOW7461 // If X is finite and scale(result, -I) != X, signal IEEE_UNDERFLOW7462 fir::IfOp outerIfOp =7463 fir::IfOp::create(builder, loc, genIsFPClass(i1Ty, args[0], finiteTest),7464 /*withElseRegion=*/false);7465 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());7466 fir::IfOp innerIfOp =7467 fir::IfOp::create(builder, loc, genIsFPClass(i1Ty, result, infiniteTest),7468 /*withElseRegion=*/true);7469 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());7470 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |7471 _FORTRAN_RUNTIME_IEEE_INEXACT);7472 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());7473 mlir::Value minusI = mlir::arith::MulIOp::create(7474 builder, loc, args[1],7475 builder.createAllOnesInteger(loc, args[1].getType()));7476 mlir::Value reverseResult = builder.createConvert(7477 loc, resultType,7478 fir::runtime::genScale(7479 builder, loc, builder.createConvert(loc, f32Ty, result), minusI));7480 genRaiseExcept(7481 _FORTRAN_RUNTIME_IEEE_UNDERFLOW | _FORTRAN_RUNTIME_IEEE_INEXACT,7482 mlir::arith::CmpFOp::create(builder, loc, mlir::arith::CmpFPredicate::ONE,7483 args[0], reverseResult));7484 builder.setInsertionPointAfter(outerIfOp);7485 return result;7486}7487 7488// SCAN7489fir::ExtendedValue7490IntrinsicLibrary::genScan(mlir::Type resultType,7491 llvm::ArrayRef<fir::ExtendedValue> args) {7492 7493 assert(args.size() == 4);7494 7495 if (isStaticallyAbsent(args[3])) {7496 // Kind not specified, so call scan/verify runtime routine that is7497 // specialized on the kind of characters in string.7498 7499 // Handle required string base arg7500 mlir::Value stringBase = fir::getBase(args[0]);7501 7502 // Handle required set string base arg7503 mlir::Value setBase = fir::getBase(args[1]);7504 7505 // Handle kind argument; it is the kind of character in this case7506 fir::KindTy kind =7507 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(7508 stringBase.getType());7509 7510 // Get string length argument7511 mlir::Value stringLen = fir::getLen(args[0]);7512 7513 // Get set string length argument7514 mlir::Value setLen = fir::getLen(args[1]);7515 7516 // Handle optional back argument7517 mlir::Value back =7518 isStaticallyAbsent(args[2])7519 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)7520 : fir::getBase(args[2]);7521 7522 return builder.createConvert(loc, resultType,7523 fir::runtime::genScan(builder, loc, kind,7524 stringBase, stringLen,7525 setBase, setLen, back));7526 }7527 // else use the runtime descriptor version of scan/verify7528 7529 // Handle optional argument, back7530 auto makeRefThenEmbox = [&](mlir::Value b) {7531 fir::LogicalType logTy = fir::LogicalType::get(7532 builder.getContext(), builder.getKindMap().defaultLogicalKind());7533 mlir::Value temp = builder.createTemporary(loc, logTy);7534 mlir::Value castb = builder.createConvert(loc, logTy, b);7535 fir::StoreOp::create(builder, loc, castb, temp);7536 return builder.createBox(loc, temp);7537 };7538 mlir::Value back =7539 fir::isUnboxedValue(args[2])7540 ? makeRefThenEmbox(*args[2].getUnboxed())7541 : fir::AbsentOp::create(builder, loc,7542 fir::BoxType::get(builder.getI1Type()));7543 7544 // Handle required string argument7545 mlir::Value string = builder.createBox(loc, args[0]);7546 7547 // Handle required set argument7548 mlir::Value set = builder.createBox(loc, args[1]);7549 7550 // Handle kind argument7551 mlir::Value kind = fir::getBase(args[3]);7552 7553 // Create result descriptor7554 fir::MutableBoxValue resultMutableBox =7555 fir::factory::createTempMutableBox(builder, loc, resultType);7556 mlir::Value resultIrBox =7557 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);7558 7559 fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,7560 kind);7561 7562 // Handle cleanup of allocatable result descriptor and return7563 return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");7564}7565 7566// SECNDS7567fir::ExtendedValue7568IntrinsicLibrary::genSecnds(mlir::Type resultType,7569 llvm::ArrayRef<fir::ExtendedValue> args) {7570 assert(args.size() == 1 && "SECNDS expects one argument");7571 7572 mlir::Value refTime = fir::getBase(args[0]);7573 7574 if (!refTime)7575 fir::emitFatalError(loc, "expected REFERENCE TIME parameter");7576 7577 mlir::Value result = fir::runtime::genSecnds(builder, loc, refTime);7578 7579 return builder.createConvert(loc, resultType, result);7580}7581 7582// SECOND7583fir::ExtendedValue7584IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType,7585 mlir::ArrayRef<fir::ExtendedValue> args) {7586 assert((args.size() == 1 && !resultType) || (args.empty() && resultType));7587 7588 fir::ExtendedValue result;7589 7590 if (resultType)7591 result = builder.createTemporary(loc, *resultType);7592 else7593 result = args[0];7594 7595 llvm::SmallVector<fir::ExtendedValue, 1> subroutineArgs(1, result);7596 genCpuTime(subroutineArgs);7597 7598 if (resultType)7599 return fir::LoadOp::create(builder, loc, fir::getBase(result));7600 return {};7601}7602 7603// SELECTED_CHAR_KIND7604fir::ExtendedValue7605IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType,7606 llvm::ArrayRef<fir::ExtendedValue> args) {7607 assert(args.size() == 1);7608 7609 return builder.createConvert(7610 loc, resultType,7611 fir::runtime::genSelectedCharKind(builder, loc, fir::getBase(args[0]),7612 fir::getLen(args[0])));7613}7614 7615// SELECTED_INT_KIND7616mlir::Value7617IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType,7618 llvm::ArrayRef<mlir::Value> args) {7619 assert(args.size() == 1);7620 7621 return builder.createConvert(7622 loc, resultType,7623 fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0])));7624}7625 7626// SELECTED_LOGICAL_KIND7627mlir::Value7628IntrinsicLibrary::genSelectedLogicalKind(mlir::Type resultType,7629 llvm::ArrayRef<mlir::Value> args) {7630 assert(args.size() == 1);7631 7632 return builder.createConvert(loc, resultType,7633 fir::runtime::genSelectedLogicalKind(7634 builder, loc, fir::getBase(args[0])));7635}7636 7637// SELECTED_REAL_KIND7638mlir::Value7639IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,7640 llvm::ArrayRef<mlir::Value> args) {7641 assert(args.size() == 3);7642 7643 // Handle optional precision(P) argument7644 mlir::Value precision =7645 isStaticallyAbsent(args[0])7646 ? fir::AbsentOp::create(builder, loc,7647 fir::ReferenceType::get(builder.getI1Type()))7648 : fir::getBase(args[0]);7649 7650 // Handle optional range(R) argument7651 mlir::Value range =7652 isStaticallyAbsent(args[1])7653 ? fir::AbsentOp::create(builder, loc,7654 fir::ReferenceType::get(builder.getI1Type()))7655 : fir::getBase(args[1]);7656 7657 // Handle optional radix(RADIX) argument7658 mlir::Value radix =7659 isStaticallyAbsent(args[2])7660 ? fir::AbsentOp::create(builder, loc,7661 fir::ReferenceType::get(builder.getI1Type()))7662 : fir::getBase(args[2]);7663 7664 return builder.createConvert(7665 loc, resultType,7666 fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));7667}7668 7669// SET_EXPONENT7670mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,7671 llvm::ArrayRef<mlir::Value> args) {7672 assert(args.size() == 2);7673 7674 return builder.createConvert(7675 loc, resultType,7676 fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),7677 fir::getBase(args[1])));7678}7679 7680/// Create a fir.box to be passed to the LBOUND/UBOUND runtime.7681/// This ensure that local lower bounds of assumed shape are propagated and that7682/// a fir.box with equivalent LBOUNDs.7683static mlir::Value7684createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,7685 const fir::ExtendedValue &array) {7686 // Assumed-rank descriptor must always carry accurate lower bound information7687 // in lowering since they cannot be tracked on the side in a vector at compile7688 // time.7689 if (array.hasAssumedRank())7690 return builder.createBox(loc, array);7691 7692 return array.match(7693 [&](const fir::BoxValue &boxValue) -> mlir::Value {7694 // This entity is mapped to a fir.box that may not contain the local7695 // lower bound information if it is a dummy. Rebox it with the local7696 // shape information.7697 mlir::Value localShape = builder.createShape(loc, array);7698 mlir::Value oldBox = boxValue.getAddr();7699 return fir::ReboxOp::create(builder, loc, oldBox.getType(), oldBox,7700 localShape,7701 /*slice=*/mlir::Value{});7702 },7703 [&](const auto &) -> mlir::Value {7704 // This is a pointer/allocatable, or an entity not yet tracked with a7705 // fir.box. For pointer/allocatable, createBox will forward the7706 // descriptor that contains the correct lower bound information. For7707 // other entities, a new fir.box will be made with the local lower7708 // bounds.7709 return builder.createBox(loc, array);7710 });7711}7712 7713/// Generate runtime call to inquire about all the bounds/extents of an7714/// array (or an assumed-rank).7715template <typename Func>7716static fir::ExtendedValue7717genBoundInquiry(fir::FirOpBuilder &builder, mlir::Location loc,7718 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,7719 int kindPos, Func genRtCall, bool needAccurateLowerBound) {7720 const fir::ExtendedValue &array = args[0];7721 const bool hasAssumedRank = array.hasAssumedRank();7722 mlir::Type resultElementType = fir::unwrapSequenceType(resultType);7723 // For assumed-rank arrays, allocate an array with the maximum rank, that is7724 // big enough to hold the result but still "small" (15 elements). Static size7725 // alloca make stack analysis/manipulation easier.7726 int rank = hasAssumedRank ? Fortran::common::maxRank : array.rank();7727 mlir::Type allocSeqType = fir::SequenceType::get(rank, resultElementType);7728 mlir::Value resultStorage = builder.createTemporary(loc, allocSeqType);7729 mlir::Value arrayBox =7730 needAccurateLowerBound7731 ? createBoxForRuntimeBoundInquiry(loc, builder, array)7732 : builder.createBox(loc, array);7733 mlir::Value kind = isStaticallyAbsent(args, kindPos)7734 ? builder.createIntegerConstant(7735 loc, builder.getI32Type(),7736 builder.getKindMap().defaultIntegerKind())7737 : fir::getBase(args[kindPos]);7738 genRtCall(builder, loc, resultStorage, arrayBox, kind);7739 if (hasAssumedRank) {7740 // Cast to fir.ref<array<?xik>> since the result extent is not a compile7741 // time constant.7742 mlir::Type baseType =7743 fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType));7744 mlir::Value resultBase =7745 builder.createConvert(loc, baseType, resultStorage);7746 mlir::Value rankValue =7747 fir::BoxRankOp::create(builder, loc, builder.getIndexType(), arrayBox);7748 return fir::ArrayBoxValue{resultBase, {rankValue}};7749 }7750 // Result extent is a compile time constant in the other cases.7751 mlir::Value rankValue =7752 builder.createIntegerConstant(loc, builder.getIndexType(), rank);7753 return fir::ArrayBoxValue{resultStorage, {rankValue}};7754}7755 7756// SHAPE7757fir::ExtendedValue7758IntrinsicLibrary::genShape(mlir::Type resultType,7759 llvm::ArrayRef<fir::ExtendedValue> args) {7760 assert(args.size() >= 1);7761 const fir::ExtendedValue &array = args[0];7762 if (array.hasAssumedRank())7763 return genBoundInquiry(builder, loc, resultType, args,7764 /*kindPos=*/1, fir::runtime::genShape,7765 /*needAccurateLowerBound=*/false);7766 int rank = array.rank();7767 mlir::Type indexType = builder.getIndexType();7768 mlir::Type extentType = fir::unwrapSequenceType(resultType);7769 mlir::Type seqType = fir::SequenceType::get(7770 {static_cast<fir::SequenceType::Extent>(rank)}, extentType);7771 mlir::Value shapeArray = builder.createTemporary(loc, seqType);7772 mlir::Type shapeAddrType = builder.getRefType(extentType);7773 for (int dim = 0; dim < rank; ++dim) {7774 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);7775 extent = builder.createConvert(loc, extentType, extent);7776 auto index = builder.createIntegerConstant(loc, indexType, dim);7777 auto shapeAddr = fir::CoordinateOp::create(builder, loc, shapeAddrType,7778 shapeArray, index);7779 fir::StoreOp::create(builder, loc, extent, shapeAddr);7780 }7781 mlir::Value shapeArrayExtent =7782 builder.createIntegerConstant(loc, indexType, rank);7783 llvm::SmallVector<mlir::Value> extents{shapeArrayExtent};7784 return fir::ArrayBoxValue{shapeArray, extents};7785}7786 7787// SHIFTL, SHIFTR7788template <typename Shift>7789mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,7790 llvm::ArrayRef<mlir::Value> args) {7791 assert(args.size() == 2);7792 7793 // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by7794 // the standard. However, several other compilers behave this way, so try and7795 // maintain compatibility with them to an extent.7796 7797 unsigned bits = resultType.getIntOrFloatBitWidth();7798 mlir::Type signlessType =7799 mlir::IntegerType::get(builder.getContext(), bits,7800 mlir::IntegerType::SignednessSemantics::Signless);7801 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);7802 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);7803 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);7804 7805 mlir::Value tooSmall = mlir::arith::CmpIOp::create(7806 builder, loc, mlir::arith::CmpIPredicate::slt, shift, zero);7807 mlir::Value tooLarge = mlir::arith::CmpIOp::create(7808 builder, loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);7809 mlir::Value outOfBounds =7810 mlir::arith::OrIOp::create(builder, loc, tooSmall, tooLarge);7811 mlir::Value word = args[0];7812 if (word.getType().isUnsignedInteger())7813 word = builder.createConvert(loc, signlessType, word);7814 mlir::Value shifted = Shift::create(builder, loc, word, shift);7815 mlir::Value result =7816 mlir::arith::SelectOp::create(builder, loc, outOfBounds, zero, shifted);7817 if (resultType.isUnsignedInteger())7818 return builder.createConvert(loc, resultType, result);7819 return result;7820}7821 7822// SHIFTA7823mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,7824 llvm::ArrayRef<mlir::Value> args) {7825 unsigned bits = resultType.getIntOrFloatBitWidth();7826 mlir::Type signlessType =7827 mlir::IntegerType::get(builder.getContext(), bits,7828 mlir::IntegerType::SignednessSemantics::Signless);7829 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);7830 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);7831 mlir::Value shiftGeBitSize = mlir::arith::CmpIOp::create(7832 builder, loc, mlir::arith::CmpIPredicate::uge, shift, bitSize);7833 7834 // Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when7835 // the shift amount is equal to the element size.7836 // So if SHIFT is equal to the bit width then it is handled as a special case.7837 // When negative or larger than the bit width, handle it like other7838 // Fortran compiler do (treat it as bit width, minus 1).7839 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);7840 mlir::Value minusOne = builder.createMinusOneInteger(loc, signlessType);7841 mlir::Value word = args[0];7842 if (word.getType().isUnsignedInteger())7843 word = builder.createConvert(loc, signlessType, word);7844 mlir::Value valueIsNeg = mlir::arith::CmpIOp::create(7845 builder, loc, mlir::arith::CmpIPredicate::slt, word, zero);7846 mlir::Value specialRes =7847 mlir::arith::SelectOp::create(builder, loc, valueIsNeg, minusOne, zero);7848 mlir::Value shifted = mlir::arith::ShRSIOp::create(builder, loc, word, shift);7849 mlir::Value result = mlir::arith::SelectOp::create(7850 builder, loc, shiftGeBitSize, specialRes, shifted);7851 if (resultType.isUnsignedInteger())7852 return builder.createConvert(loc, resultType, result);7853 return result;7854}7855 7856void IntrinsicLibrary::genShowDescriptor(7857 llvm::ArrayRef<fir::ExtendedValue> args) {7858 assert(args.size() == 1 && "expected single argument for show_descriptor");7859 const mlir::Value descriptor = fir::getBase(args[0]);7860 7861 assert(fir::isa_box_type(descriptor.getType()) &&7862 "argument must have been lowered to box type");7863 fir::runtime::genShowDescriptor(builder, loc, descriptor);7864}7865 7866// SIGNAL7867void IntrinsicLibrary::genSignalSubroutine(7868 llvm::ArrayRef<fir::ExtendedValue> args) {7869 assert(args.size() == 2 || args.size() == 3);7870 mlir::Value number = fir::getBase(args[0]);7871 mlir::Value handler = fir::getBase(args[1]);7872 mlir::Value status;7873 if (args.size() == 3)7874 status = fir::getBase(args[2]);7875 fir::runtime::genSignal(builder, loc, number, handler, status);7876}7877 7878// SIGN7879mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,7880 llvm::ArrayRef<mlir::Value> args) {7881 assert(args.size() == 2);7882 if (mlir::isa<mlir::IntegerType>(resultType)) {7883 mlir::Value abs = genAbs(resultType, {args[0]});7884 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);7885 auto neg = mlir::arith::SubIOp::create(builder, loc, zero, abs);7886 auto cmp = mlir::arith::CmpIOp::create(7887 builder, loc, mlir::arith::CmpIPredicate::slt, args[1], zero);7888 return mlir::arith::SelectOp::create(builder, loc, cmp, neg, abs);7889 }7890 return genRuntimeCall("sign", resultType, args);7891}7892 7893// SIND7894mlir::Value IntrinsicLibrary::genSind(mlir::Type resultType,7895 llvm::ArrayRef<mlir::Value> args) {7896 assert(args.size() == 1);7897 mlir::MLIRContext *context = builder.getContext();7898 mlir::FunctionType ftype =7899 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});7900 const llvm::fltSemantics &fltSem =7901 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();7902 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);7903 mlir::Value factor = builder.createRealConstant(7904 loc, resultType, pi / llvm::APFloat(fltSem, "180.0"));7905 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);7906 return getRuntimeCallGenerator("sin", ftype)(builder, loc, {arg});7907}7908 7909// SINPI7910mlir::Value IntrinsicLibrary::genSinpi(mlir::Type resultType,7911 llvm::ArrayRef<mlir::Value> args) {7912 assert(args.size() == 1);7913 mlir::MLIRContext *context = builder.getContext();7914 mlir::FunctionType ftype =7915 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});7916 llvm::APFloat pi =7917 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),7918 llvm::numbers::pis);7919 mlir::Value factor = builder.createRealConstant(loc, resultType, pi);7920 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);7921 return getRuntimeCallGenerator("sin", ftype)(builder, loc, {arg});7922}7923 7924// SIZE7925fir::ExtendedValue7926IntrinsicLibrary::genSize(mlir::Type resultType,7927 llvm::ArrayRef<fir::ExtendedValue> args) {7928 // Note that the value of the KIND argument is already reflected in the7929 // resultType7930 assert(args.size() == 3);7931 7932 // Get the ARRAY argument7933 mlir::Value array = builder.createBox(loc, args[0]);7934 7935 // The front-end rewrites SIZE without the DIM argument to7936 // an array of SIZE with DIM in most cases, but it may not be7937 // possible in some cases like when in SIZE(function_call()).7938 if (isStaticallyAbsent(args, 1))7939 return builder.createConvert(loc, resultType,7940 fir::runtime::genSize(builder, loc, array));7941 7942 // Get the DIM argument.7943 mlir::Value dim = fir::getBase(args[1]);7944 if (!args[0].hasAssumedRank())7945 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {7946 // If both DIM and the rank are compile time constants, skip the runtime7947 // call.7948 return builder.createConvert(7949 loc, resultType,7950 fir::factory::readExtent(builder, loc, fir::BoxValue{array},7951 cstDim.value() - 1));7952 }7953 if (!fir::isa_ref_type(dim.getType()))7954 return builder.createConvert(7955 loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));7956 7957 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);7958 return builder7959 .genIfOp(loc, {resultType}, isDynamicallyAbsent,7960 /*withElseRegion=*/true)7961 .genThen([&]() {7962 mlir::Value size = builder.createConvert(7963 loc, resultType, fir::runtime::genSize(builder, loc, array));7964 fir::ResultOp::create(builder, loc, size);7965 })7966 .genElse([&]() {7967 mlir::Value dimValue = fir::LoadOp::create(builder, loc, dim);7968 mlir::Value size = builder.createConvert(7969 loc, resultType,7970 fir::runtime::genSizeDim(builder, loc, array, dimValue));7971 fir::ResultOp::create(builder, loc, size);7972 })7973 .getResults()[0];7974}7975 7976// SIZEOF7977fir::ExtendedValue7978IntrinsicLibrary::genSizeOf(mlir::Type resultType,7979 llvm::ArrayRef<fir::ExtendedValue> args) {7980 assert(args.size() == 1);7981 mlir::Value box = fir::getBase(args[0]);7982 mlir::Value eleSize =7983 fir::BoxEleSizeOp::create(builder, loc, resultType, box);7984 if (!fir::isArray(args[0]))7985 return eleSize;7986 mlir::Value arraySize = builder.createConvert(7987 loc, resultType, fir::runtime::genSize(builder, loc, box));7988 return mlir::arith::MulIOp::create(builder, loc, eleSize, arraySize);7989}7990 7991// TAND7992mlir::Value IntrinsicLibrary::genTand(mlir::Type resultType,7993 llvm::ArrayRef<mlir::Value> args) {7994 assert(args.size() == 1);7995 mlir::MLIRContext *context = builder.getContext();7996 mlir::FunctionType ftype =7997 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});7998 const llvm::fltSemantics &fltSem =7999 llvm::cast<mlir::FloatType>(resultType).getFloatSemantics();8000 llvm::APFloat pi = llvm::APFloat(fltSem, llvm::numbers::pis);8001 mlir::Value factor = builder.createRealConstant(8002 loc, resultType, pi / llvm::APFloat(fltSem, "180.0"));8003 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);8004 return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg});8005}8006 8007// TANPI8008mlir::Value IntrinsicLibrary::genTanpi(mlir::Type resultType,8009 llvm::ArrayRef<mlir::Value> args) {8010 assert(args.size() == 1);8011 mlir::MLIRContext *context = builder.getContext();8012 mlir::FunctionType ftype =8013 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});8014 llvm::APFloat pi =8015 llvm::APFloat(llvm::cast<mlir::FloatType>(resultType).getFloatSemantics(),8016 llvm::numbers::pis);8017 mlir::Value factor = builder.createRealConstant(loc, resultType, pi);8018 mlir::Value arg = mlir::arith::MulFOp::create(builder, loc, args[0], factor);8019 return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg});8020}8021 8022// TEAM_NUMBER8023fir::ExtendedValue8024IntrinsicLibrary::genTeamNumber(mlir::Type,8025 llvm::ArrayRef<fir::ExtendedValue> args) {8026 converter->checkCoarrayEnabled();8027 assert(args.size() == 1);8028 return mif::TeamNumberOp::create(builder, loc,8029 /*team*/ fir::getBase(args[0]));8030}8031 8032// THIS_IMAGE8033fir::ExtendedValue8034IntrinsicLibrary::genThisImage(mlir::Type resultType,8035 llvm::ArrayRef<fir::ExtendedValue> args) {8036 converter->checkCoarrayEnabled();8037 assert(args.size() >= 1 && args.size() <= 3);8038 const bool coarrayIsAbsent = args.size() == 1;8039 mlir::Value team = fir::getBase(args[args.size() - 1]);8040 8041 if (!coarrayIsAbsent)8042 TODO(loc, "this_image with coarray argument.");8043 mlir::Value res = mif::ThisImageOp::create(builder, loc, team);8044 return builder.createConvert(loc, resultType, res);8045}8046 8047// TRAILZ8048mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,8049 llvm::ArrayRef<mlir::Value> args) {8050 assert(args.size() == 1);8051 8052 mlir::Value result =8053 mlir::math::CountTrailingZerosOp::create(builder, loc, args);8054 8055 return builder.createConvert(loc, resultType, result);8056}8057 8058static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {8059 return exv.match(8060 [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },8061 [](const fir::CharArrayBoxValue &arr) {8062 return arr.getLBounds().empty();8063 },8064 [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },8065 [](const auto &) { return false; });8066}8067 8068/// Compute the lower bound in dimension \p dim (zero based) of \p array8069/// taking care of returning one when the related extent is zero.8070static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,8071 const fir::ExtendedValue &array, unsigned dim,8072 mlir::Value zero, mlir::Value one) {8073 assert(dim < array.rank() && "invalid dimension");8074 if (hasDefaultLowerBound(array))8075 return one;8076 mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);8077 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);8078 zero = builder.createConvert(loc, extent.getType(), zero);8079 // Note: for assumed size, the extent is -1, and the lower bound should8080 // be returned. It is important to test extent == 0 and not extent > 0.8081 auto dimIsEmpty = mlir::arith::CmpIOp::create(8082 builder, loc, mlir::arith::CmpIPredicate::eq, extent, zero);8083 one = builder.createConvert(loc, lb.getType(), one);8084 return mlir::arith::SelectOp::create(builder, loc, dimIsEmpty, one, lb);8085}8086 8087// LBOUND8088fir::ExtendedValue8089IntrinsicLibrary::genLbound(mlir::Type resultType,8090 llvm::ArrayRef<fir::ExtendedValue> args) {8091 assert(args.size() == 2 || args.size() == 3);8092 const fir::ExtendedValue &array = args[0];8093 // Semantics builds signatures for LBOUND calls as either8094 // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).8095 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);8096 if (array.hasAssumedRank() && dimIsAbsent) {8097 int kindPos = args.size() == 2 ? 1 : 2;8098 return genBoundInquiry(builder, loc, resultType, args, kindPos,8099 fir::runtime::genLbound,8100 /*needAccurateLowerBound=*/true);8101 }8102 8103 mlir::Type indexType = builder.getIndexType();8104 8105 if (dimIsAbsent) {8106 // DIM is absent and the rank of array is a compile time constant.8107 mlir::Type lbType = fir::unwrapSequenceType(resultType);8108 unsigned rank = array.rank();8109 mlir::Type lbArrayType = fir::SequenceType::get(8110 {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);8111 mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);8112 mlir::Type lbAddrType = builder.getRefType(lbType);8113 mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);8114 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);8115 for (unsigned dim = 0; dim < rank; ++dim) {8116 mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);8117 lb = builder.createConvert(loc, lbType, lb);8118 auto index = builder.createIntegerConstant(loc, indexType, dim);8119 auto lbAddr =8120 fir::CoordinateOp::create(builder, loc, lbAddrType, lbArray, index);8121 fir::StoreOp::create(builder, loc, lb, lbAddr);8122 }8123 mlir::Value lbArrayExtent =8124 builder.createIntegerConstant(loc, indexType, rank);8125 llvm::SmallVector<mlir::Value> extents{lbArrayExtent};8126 return fir::ArrayBoxValue{lbArray, extents};8127 }8128 // DIM is present.8129 mlir::Value dim = fir::getBase(args[1]);8130 8131 // If it is a compile time constant and the rank is known, skip the runtime8132 // call.8133 if (!array.hasAssumedRank())8134 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {8135 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);8136 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);8137 mlir::Value lb =8138 computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);8139 return builder.createConvert(loc, resultType, lb);8140 }8141 8142 fir::ExtendedValue box = createBoxForRuntimeBoundInquiry(loc, builder, array);8143 return builder.createConvert(8144 loc, resultType,8145 fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));8146}8147 8148// UBOUND8149fir::ExtendedValue8150IntrinsicLibrary::genUbound(mlir::Type resultType,8151 llvm::ArrayRef<fir::ExtendedValue> args) {8152 assert(args.size() == 3 || args.size() == 2);8153 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);8154 if (!dimIsAbsent) {8155 // Handle calls to UBOUND with the DIM argument, which return a scalar8156 mlir::Value extent = fir::getBase(genSize(resultType, args));8157 mlir::Value lbound = fir::getBase(genLbound(resultType, args));8158 8159 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);8160 mlir::Value ubound = mlir::arith::SubIOp::create(builder, loc, lbound, one);8161 return mlir::arith::AddIOp::create(builder, loc, ubound, extent);8162 }8163 // Handle calls to UBOUND without the DIM argument, which return an array8164 int kindPos = args.size() == 2 ? 1 : 2;8165 return genBoundInquiry(builder, loc, resultType, args, kindPos,8166 fir::runtime::genUbound,8167 /*needAccurateLowerBound=*/true);8168}8169 8170// SPACING8171mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,8172 llvm::ArrayRef<mlir::Value> args) {8173 assert(args.size() == 1);8174 8175 return builder.createConvert(8176 loc, resultType,8177 fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));8178}8179 8180// SPREAD8181fir::ExtendedValue8182IntrinsicLibrary::genSpread(mlir::Type resultType,8183 llvm::ArrayRef<fir::ExtendedValue> args) {8184 8185 assert(args.size() == 3);8186 8187 // Handle source argument8188 mlir::Value source = builder.createBox(loc, args[0]);8189 fir::BoxValue sourceTmp = source;8190 unsigned sourceRank = sourceTmp.rank();8191 8192 // Handle Dim argument8193 mlir::Value dim = fir::getBase(args[1]);8194 8195 // Handle ncopies argument8196 mlir::Value ncopies = fir::getBase(args[2]);8197 8198 // Generate result descriptor8199 mlir::Type resultArrayType =8200 builder.getVarLenSeqTy(resultType, sourceRank + 1);8201 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(8202 builder, loc, resultArrayType, {},8203 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});8204 mlir::Value resultIrBox =8205 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8206 8207 fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);8208 8209 return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD");8210}8211 8212// STORAGE_SIZE8213fir::ExtendedValue8214IntrinsicLibrary::genStorageSize(mlir::Type resultType,8215 llvm::ArrayRef<fir::ExtendedValue> args) {8216 assert(args.size() == 2 || args.size() == 1);8217 mlir::Value box = fir::getBase(args[0]);8218 mlir::Type boxTy = box.getType();8219 mlir::Type kindTy = builder.getDefaultIntegerType();8220 bool needRuntimeCheck = false;8221 std::string errorMsg;8222 8223 if (fir::isUnlimitedPolymorphicType(boxTy) &&8224 (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) {8225 needRuntimeCheck = true;8226 errorMsg =8227 fir::isPointerType(boxTy)8228 ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE"8229 : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE";8230 }8231 const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>();8232 if (needRuntimeCheck && mutBox) {8233 mlir::Value isNotAllocOrAssoc =8234 fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox);8235 builder.genIfThen(loc, isNotAllocOrAssoc)8236 .genThen([&]() {8237 fir::runtime::genReportFatalUserError(builder, loc, errorMsg);8238 })8239 .end();8240 }8241 8242 // Handle optional kind argument8243 bool absentKind = isStaticallyAbsent(args, 1);8244 if (!absentKind) {8245 mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp();8246 assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) &&8247 "kind not a constant");8248 auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind);8249 kindTy = builder.getIntegerType(8250 builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));8251 }8252 8253 box = builder.createBox(loc, args[0],8254 /*isPolymorphic=*/args[0].isPolymorphic());8255 mlir::Value eleSize = fir::BoxEleSizeOp::create(builder, loc, kindTy, box);8256 mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);8257 return mlir::arith::MulIOp::create(builder, loc, eleSize, c8);8258}8259 8260// SUM8261fir::ExtendedValue8262IntrinsicLibrary::genSum(mlir::Type resultType,8263 llvm::ArrayRef<fir::ExtendedValue> args) {8264 return genReduction(fir::runtime::genSum, fir::runtime::genSumDim, "SUM",8265 resultType, args);8266}8267 8268// SYSTEM8269fir::ExtendedValue8270IntrinsicLibrary::genSystem(std::optional<mlir::Type> resultType,8271 llvm::ArrayRef<fir::ExtendedValue> args) {8272 assert((!resultType && (args.size() == 2)) ||8273 (resultType && (args.size() == 1)));8274 mlir::Value command = fir::getBase(args[0]);8275 assert(command && "expected COMMAND parameter");8276 8277 fir::ExtendedValue exitstat;8278 if (resultType) {8279 mlir::Value tmp = builder.createTemporary(loc, *resultType);8280 exitstat = builder.createBox(loc, tmp);8281 } else {8282 exitstat = args[1];8283 }8284 8285 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());8286 8287 mlir::Value waitBool = builder.createBool(loc, true);8288 mlir::Value exitstatBox =8289 isStaticallyPresent(exitstat)8290 ? fir::getBase(exitstat)8291 : fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();8292 8293 // Create a dummmy cmdstat to prevent EXECUTE_COMMAND_LINE terminate itself8294 // when cmdstat is assigned with a non-zero value but not present8295 mlir::Value tempValue =8296 builder.createIntegerConstant(loc, builder.getI16Type(), 0);8297 mlir::Value temp = builder.createTemporary(loc, builder.getI16Type());8298 fir::StoreOp::create(builder, loc, tempValue, temp);8299 mlir::Value cmdstatBox = builder.createBox(loc, temp);8300 8301 mlir::Value cmdmsgBox =8302 fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();8303 8304 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,8305 exitstatBox, cmdstatBox, cmdmsgBox);8306 8307 if (resultType) {8308 mlir::Value exitstatAddr =8309 fir::BoxAddrOp::create(builder, loc, exitstatBox);8310 return fir::LoadOp::create(builder, loc, fir::getBase(exitstatAddr));8311 }8312 return {};8313}8314 8315// SYSTEM_CLOCK8316void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {8317 assert(args.size() == 3);8318 fir::runtime::genSystemClock(builder, loc, fir::getBase(args[0]),8319 fir::getBase(args[1]), fir::getBase(args[2]));8320}8321 8322// SLEEP8323void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) {8324 assert(args.size() == 1 && "SLEEP has one compulsory argument");8325 fir::runtime::genSleep(builder, loc, fir::getBase(args[0]));8326}8327 8328// TRANSFER8329fir::ExtendedValue8330IntrinsicLibrary::genTransfer(mlir::Type resultType,8331 llvm::ArrayRef<fir::ExtendedValue> args) {8332 8333 assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.8334 8335 // Handle source argument8336 mlir::Value source = builder.createBox(loc, args[0]);8337 8338 // Handle mold argument8339 mlir::Value mold = builder.createBox(loc, args[1]);8340 fir::BoxValue moldTmp = mold;8341 unsigned moldRank = moldTmp.rank();8342 8343 bool absentSize = (args.size() == 2);8344 8345 // Create mutable fir.box to be passed to the runtime for the result.8346 mlir::Type type = (moldRank == 0 && absentSize)8347 ? resultType8348 : builder.getVarLenSeqTy(resultType, 1);8349 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(8350 builder, loc, type, {},8351 fir::isPolymorphicType(mold.getType()) ? mold : mlir::Value{});8352 8353 if (moldRank == 0 && absentSize) {8354 // This result is a scalar in this case.8355 mlir::Value resultIrBox =8356 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8357 8358 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);8359 } else {8360 // The result is a rank one array in this case.8361 mlir::Value resultIrBox =8362 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8363 8364 if (absentSize) {8365 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);8366 } else {8367 mlir::Value sizeArg = fir::getBase(args[2]);8368 fir::runtime::genTransferSize(builder, loc, resultIrBox, source, mold,8369 sizeArg);8370 }8371 }8372 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSFER");8373}8374 8375// TRANSPOSE8376fir::ExtendedValue8377IntrinsicLibrary::genTranspose(mlir::Type resultType,8378 llvm::ArrayRef<fir::ExtendedValue> args) {8379 8380 assert(args.size() == 1);8381 8382 // Handle source argument8383 mlir::Value source = builder.createBox(loc, args[0]);8384 8385 // Create mutable fir.box to be passed to the runtime for the result.8386 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);8387 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(8388 builder, loc, resultArrayType, {},8389 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});8390 mlir::Value resultIrBox =8391 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8392 // Call runtime. The runtime is allocating the result.8393 fir::runtime::genTranspose(builder, loc, resultIrBox, source);8394 // Read result from mutable fir.box and add it to the list of temps to be8395 // finalized by the StatementContext.8396 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSPOSE");8397}8398 8399// TIME8400mlir::Value IntrinsicLibrary::genTime(mlir::Type resultType,8401 llvm::ArrayRef<mlir::Value> args) {8402 assert(args.size() == 0);8403 return builder.createConvert(loc, resultType,8404 fir::runtime::genTime(builder, loc));8405}8406 8407// TRIM8408fir::ExtendedValue8409IntrinsicLibrary::genTrim(mlir::Type resultType,8410 llvm::ArrayRef<fir::ExtendedValue> args) {8411 assert(args.size() == 1);8412 mlir::Value string = builder.createBox(loc, args[0]);8413 // Create mutable fir.box to be passed to the runtime for the result.8414 fir::MutableBoxValue resultMutableBox =8415 fir::factory::createTempMutableBox(builder, loc, resultType);8416 mlir::Value resultIrBox =8417 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8418 // Call runtime. The runtime is allocating the result.8419 fir::runtime::genTrim(builder, loc, resultIrBox, string);8420 // Read result from mutable fir.box and add it to the list of temps to be8421 // finalized by the StatementContext.8422 return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");8423}8424 8425// Compare two FIR values and return boolean result as i1.8426template <Extremum extremum, ExtremumBehavior behavior>8427static mlir::Value createExtremumCompare(mlir::Location loc,8428 fir::FirOpBuilder &builder,8429 mlir::Value left, mlir::Value right) {8430 mlir::Type type = left.getType();8431 mlir::arith::CmpIPredicate integerPredicate =8432 type.isUnsignedInteger() ? extremum == Extremum::Max8433 ? mlir::arith::CmpIPredicate::ugt8434 : mlir::arith::CmpIPredicate::ult8435 : extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt8436 : mlir::arith::CmpIPredicate::slt;8437 static constexpr mlir::arith::CmpFPredicate orderedCmp =8438 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT8439 : mlir::arith::CmpFPredicate::OLT;8440 mlir::Value result;8441 if (fir::isa_real(type)) {8442 // Note: the signaling/quit aspect of the result required by IEEE8443 // cannot currently be obtained with LLVM without ad-hoc runtime.8444 if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {8445 // Return the number if one of the inputs is NaN and the other is8446 // a number.8447 auto leftIsResult =8448 mlir::arith::CmpFOp::create(builder, loc, orderedCmp, left, right);8449 auto rightIsNan = mlir::arith::CmpFOp::create(8450 builder, loc, mlir::arith::CmpFPredicate::UNE, right, right);8451 result =8452 mlir::arith::OrIOp::create(builder, loc, leftIsResult, rightIsNan);8453 } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {8454 // Always return NaNs if one the input is NaNs8455 auto leftIsResult =8456 mlir::arith::CmpFOp::create(builder, loc, orderedCmp, left, right);8457 auto leftIsNan = mlir::arith::CmpFOp::create(8458 builder, loc, mlir::arith::CmpFPredicate::UNE, left, left);8459 result =8460 mlir::arith::OrIOp::create(builder, loc, leftIsResult, leftIsNan);8461 } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {8462 // If the left is a NaN, return the right whatever it is.8463 result =8464 mlir::arith::CmpFOp::create(builder, loc, orderedCmp, left, right);8465 } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {8466 // If one of the operand is a NaN, return left whatever it is.8467 static constexpr auto unorderedCmp =8468 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT8469 : mlir::arith::CmpFPredicate::ULT;8470 result =8471 mlir::arith::CmpFOp::create(builder, loc, unorderedCmp, left, right);8472 } else {8473 // TODO: ieeeMinNum/ieeeMaxNum8474 static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,8475 "ieeeMinNum/ieeeMaxNum behavior not implemented");8476 }8477 } else if (fir::isa_integer(type)) {8478 if (type.isUnsignedInteger()) {8479 mlir::Type signlessType = mlir::IntegerType::get(8480 builder.getContext(), type.getIntOrFloatBitWidth(),8481 mlir::IntegerType::SignednessSemantics::Signless);8482 left = builder.createConvert(loc, signlessType, left);8483 right = builder.createConvert(loc, signlessType, right);8484 }8485 result = mlir::arith::CmpIOp::create(builder, loc, integerPredicate, left,8486 right);8487 } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {8488 // TODO: ! character min and max is tricky because the result8489 // length is the length of the longest argument!8490 // So we may need a temp.8491 TODO(loc, "intrinsic: min and max for CHARACTER");8492 }8493 assert(result && "result must be defined");8494 return result;8495}8496 8497// UNLINK8498fir::ExtendedValue8499IntrinsicLibrary::genUnlink(std::optional<mlir::Type> resultType,8500 llvm::ArrayRef<fir::ExtendedValue> args) {8501 assert((resultType.has_value() && args.size() == 1) ||8502 (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));8503 8504 mlir::Value path = fir::getBase(args[0]);8505 mlir::Value pathLength = fir::getLen(args[0]);8506 mlir::Value statusValue =8507 fir::runtime::genUnlink(builder, loc, path, pathLength);8508 8509 if (resultType.has_value()) {8510 // Function form, return status.8511 return builder.createConvert(loc, *resultType, statusValue);8512 }8513 8514 // Subroutine form, store status and return none.8515 const fir::ExtendedValue &status = args[1];8516 if (!isStaticallyAbsent(status)) {8517 mlir::Value statusAddr = fir::getBase(status);8518 mlir::Value statusIsPresentAtRuntime =8519 builder.genIsNotNullAddr(loc, statusAddr);8520 builder.genIfThen(loc, statusIsPresentAtRuntime)8521 .genThen([&]() {8522 builder.createStoreWithConvert(loc, statusValue, statusAddr);8523 })8524 .end();8525 }8526 8527 return {};8528}8529 8530// UNPACK8531fir::ExtendedValue8532IntrinsicLibrary::genUnpack(mlir::Type resultType,8533 llvm::ArrayRef<fir::ExtendedValue> args) {8534 assert(args.size() == 3);8535 8536 // Handle required vector argument8537 mlir::Value vector = builder.createBox(loc, args[0]);8538 8539 // Handle required mask argument8540 fir::BoxValue maskBox = builder.createBox(loc, args[1]);8541 mlir::Value mask = fir::getBase(maskBox);8542 unsigned maskRank = maskBox.rank();8543 8544 // Handle required field argument8545 mlir::Value field = builder.createBox(loc, args[2]);8546 8547 // Create mutable fir.box to be passed to the runtime for the result.8548 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);8549 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(8550 builder, loc, resultArrayType, {},8551 fir::isPolymorphicType(vector.getType()) ? vector : mlir::Value{});8552 mlir::Value resultIrBox =8553 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8554 8555 fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);8556 8557 return readAndAddCleanUp(resultMutableBox, resultType, "UNPACK");8558}8559 8560// VERIFY8561fir::ExtendedValue8562IntrinsicLibrary::genVerify(mlir::Type resultType,8563 llvm::ArrayRef<fir::ExtendedValue> args) {8564 8565 assert(args.size() == 4);8566 8567 if (isStaticallyAbsent(args[3])) {8568 // Kind not specified, so call scan/verify runtime routine that is8569 // specialized on the kind of characters in string.8570 8571 // Handle required string base arg8572 mlir::Value stringBase = fir::getBase(args[0]);8573 8574 // Handle required set string base arg8575 mlir::Value setBase = fir::getBase(args[1]);8576 8577 // Handle kind argument; it is the kind of character in this case8578 fir::KindTy kind =8579 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(8580 stringBase.getType());8581 8582 // Get string length argument8583 mlir::Value stringLen = fir::getLen(args[0]);8584 8585 // Get set string length argument8586 mlir::Value setLen = fir::getLen(args[1]);8587 8588 // Handle optional back argument8589 mlir::Value back =8590 isStaticallyAbsent(args[2])8591 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)8592 : fir::getBase(args[2]);8593 8594 return builder.createConvert(8595 loc, resultType,8596 fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,8597 setBase, setLen, back));8598 }8599 // else use the runtime descriptor version of scan/verify8600 8601 // Handle optional argument, back8602 auto makeRefThenEmbox = [&](mlir::Value b) {8603 fir::LogicalType logTy = fir::LogicalType::get(8604 builder.getContext(), builder.getKindMap().defaultLogicalKind());8605 mlir::Value temp = builder.createTemporary(loc, logTy);8606 mlir::Value castb = builder.createConvert(loc, logTy, b);8607 fir::StoreOp::create(builder, loc, castb, temp);8608 return builder.createBox(loc, temp);8609 };8610 mlir::Value back =8611 fir::isUnboxedValue(args[2])8612 ? makeRefThenEmbox(*args[2].getUnboxed())8613 : fir::AbsentOp::create(builder, loc,8614 fir::BoxType::get(builder.getI1Type()));8615 8616 // Handle required string argument8617 mlir::Value string = builder.createBox(loc, args[0]);8618 8619 // Handle required set argument8620 mlir::Value set = builder.createBox(loc, args[1]);8621 8622 // Handle kind argument8623 mlir::Value kind = fir::getBase(args[3]);8624 8625 // Create result descriptor8626 fir::MutableBoxValue resultMutableBox =8627 fir::factory::createTempMutableBox(builder, loc, resultType);8628 mlir::Value resultIrBox =8629 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8630 8631 fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,8632 back, kind);8633 8634 // Handle cleanup of allocatable result descriptor and return8635 return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");8636}8637 8638/// Process calls to Minloc, Maxloc intrinsic functions8639template <typename FN, typename FD>8640fir::ExtendedValue8641IntrinsicLibrary::genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg,8642 mlir::Type resultType,8643 llvm::ArrayRef<fir::ExtendedValue> args) {8644 8645 assert(args.size() == 5);8646 8647 // Handle required array argument8648 mlir::Value array = builder.createBox(loc, args[0]);8649 unsigned rank = fir::BoxValue(array).rank();8650 assert(rank >= 1);8651 8652 // Handle optional mask argument8653 auto mask = isStaticallyAbsent(args[2])8654 ? fir::AbsentOp::create(8655 builder, loc, fir::BoxType::get(builder.getI1Type()))8656 : builder.createBox(loc, args[2]);8657 8658 // Handle optional kind argument8659 auto kind = isStaticallyAbsent(args[3])8660 ? builder.createIntegerConstant(8661 loc, builder.getIndexType(),8662 builder.getKindMap().defaultIntegerKind())8663 : fir::getBase(args[3]);8664 8665 // Handle optional back argument8666 auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)8667 : fir::getBase(args[4]);8668 8669 bool absentDim = isStaticallyAbsent(args[1]);8670 8671 if (!absentDim && rank == 1) {8672 // If dim argument is present and the array is rank 1, then the result is8673 // a scalar (since the the result is rank-1 or 0).8674 // Therefore, we use a scalar result descriptor with Min/MaxlocDim().8675 mlir::Value dim = fir::getBase(args[1]);8676 // Create mutable fir.box to be passed to the runtime for the result.8677 fir::MutableBoxValue resultMutableBox =8678 fir::factory::createTempMutableBox(builder, loc, resultType);8679 mlir::Value resultIrBox =8680 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8681 8682 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);8683 8684 // Handle cleanup of allocatable result descriptor and return8685 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);8686 }8687 8688 // Note: The Min/Maxloc/val cases below have an array result.8689 8690 // Create mutable fir.box to be passed to the runtime for the result.8691 mlir::Type resultArrayType =8692 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);8693 fir::MutableBoxValue resultMutableBox =8694 fir::factory::createTempMutableBox(builder, loc, resultArrayType);8695 mlir::Value resultIrBox =8696 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8697 8698 if (absentDim) {8699 // Handle min/maxloc/val case where there is no dim argument8700 // (calls Min/Maxloc()/MinMaxval() runtime routine)8701 func(builder, loc, resultIrBox, array, mask, kind, back);8702 } else {8703 // else handle min/maxloc case with dim argument (calls8704 // Min/Max/loc/val/Dim() runtime routine).8705 mlir::Value dim = fir::getBase(args[1]);8706 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);8707 }8708 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);8709}8710 8711// MAXLOC8712fir::ExtendedValue8713IntrinsicLibrary::genMaxloc(mlir::Type resultType,8714 llvm::ArrayRef<fir::ExtendedValue> args) {8715 return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,8716 "MAXLOC", resultType, args);8717}8718 8719/// Process calls to Maxval and Minval8720template <typename FN, typename FD, typename FC>8721fir::ExtendedValue8722IntrinsicLibrary::genExtremumVal(FN func, FD funcDim, FC funcChar,8723 llvm::StringRef errMsg, mlir::Type resultType,8724 llvm::ArrayRef<fir::ExtendedValue> args) {8725 8726 assert(args.size() == 3);8727 8728 // Handle required array argument8729 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);8730 mlir::Value array = fir::getBase(arryTmp);8731 int rank = arryTmp.rank();8732 assert(rank >= 1);8733 bool hasCharacterResult = arryTmp.isCharacter();8734 8735 // Handle optional mask argument8736 auto mask = isStaticallyAbsent(args[2])8737 ? fir::AbsentOp::create(8738 builder, loc, fir::BoxType::get(builder.getI1Type()))8739 : builder.createBox(loc, args[2]);8740 8741 bool absentDim = isStaticallyAbsent(args[1]);8742 8743 // For Maxval/MinVal, we call the type specific versions of8744 // Maxval/Minval because the result is scalar in the case below.8745 if (!hasCharacterResult && (absentDim || rank == 1))8746 return func(builder, loc, array, mask);8747 8748 if (hasCharacterResult && (absentDim || rank == 1)) {8749 // Create mutable fir.box to be passed to the runtime for the result.8750 fir::MutableBoxValue resultMutableBox =8751 fir::factory::createTempMutableBox(builder, loc, resultType);8752 mlir::Value resultIrBox =8753 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);8754 8755 funcChar(builder, loc, resultIrBox, array, mask);8756 8757 // Handle cleanup of allocatable result descriptor and return8758 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);8759 }8760 8761 // Handle Min/Maxval cases that have an array result.8762 auto resultMutableBox =8763 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);8764 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);8765}8766 8767// MAXVAL8768fir::ExtendedValue8769IntrinsicLibrary::genMaxval(mlir::Type resultType,8770 llvm::ArrayRef<fir::ExtendedValue> args) {8771 return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,8772 fir::runtime::genMaxvalChar, "MAXVAL", resultType,8773 args);8774}8775 8776// MINLOC8777fir::ExtendedValue8778IntrinsicLibrary::genMinloc(mlir::Type resultType,8779 llvm::ArrayRef<fir::ExtendedValue> args) {8780 return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,8781 "MINLOC", resultType, args);8782}8783 8784// MINVAL8785fir::ExtendedValue8786IntrinsicLibrary::genMinval(mlir::Type resultType,8787 llvm::ArrayRef<fir::ExtendedValue> args) {8788 return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,8789 fir::runtime::genMinvalChar, "MINVAL", resultType,8790 args);8791}8792 8793// MIN and MAX8794template <Extremum extremum, ExtremumBehavior behavior>8795mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,8796 llvm::ArrayRef<mlir::Value> args) {8797 assert(args.size() >= 1);8798 mlir::Value result = args[0];8799 for (auto arg : args.drop_front()) {8800 mlir::Value mask =8801 createExtremumCompare<extremum, behavior>(loc, builder, result, arg);8802 result = mlir::arith::SelectOp::create(builder, loc, mask, result, arg);8803 }8804 return result;8805}8806 8807//===----------------------------------------------------------------------===//8808// Argument lowering rules interface for intrinsic or intrinsic module8809// procedure.8810//===----------------------------------------------------------------------===//8811 8812const IntrinsicArgumentLoweringRules *8813getIntrinsicArgumentLowering(llvm::StringRef specificName) {8814 llvm::StringRef name = genericName(specificName);8815 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))8816 if (!handler->argLoweringRules.hasDefaultRules())8817 return &handler->argLoweringRules;8818 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))8819 if (!ppcHandler->argLoweringRules.hasDefaultRules())8820 return &ppcHandler->argLoweringRules;8821 if (const IntrinsicHandler *cudaHandler = findCUDAIntrinsicHandler(name))8822 if (!cudaHandler->argLoweringRules.hasDefaultRules())8823 return &cudaHandler->argLoweringRules;8824 return nullptr;8825}8826 8827const IntrinsicArgumentLoweringRules *8828IntrinsicHandlerEntry::getArgumentLoweringRules() const {8829 if (const IntrinsicHandler *const *handler =8830 std::get_if<const IntrinsicHandler *>(&entry)) {8831 assert(*handler);8832 if (!(*handler)->argLoweringRules.hasDefaultRules())8833 return &(*handler)->argLoweringRules;8834 }8835 return nullptr;8836}8837 8838/// Return how argument \p argName should be lowered given the rules for the8839/// intrinsic function.8840fir::ArgLoweringRule8841lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &rules,8842 unsigned position) {8843 assert(position < sizeof(rules.args) / (sizeof(decltype(*rules.args))) &&8844 "invalid argument");8845 return {rules.args[position].lowerAs,8846 rules.args[position].handleDynamicOptional};8847}8848 8849//===----------------------------------------------------------------------===//8850// Public intrinsic call helpers8851//===----------------------------------------------------------------------===//8852 8853std::pair<fir::ExtendedValue, bool>8854genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,8855 llvm::StringRef name, std::optional<mlir::Type> resultType,8856 llvm::ArrayRef<fir::ExtendedValue> args,8857 Fortran::lower::AbstractConverter *converter) {8858 return IntrinsicLibrary{builder, loc, converter}.genIntrinsicCall(8859 name, resultType, args);8860}8861 8862mlir::Value genMax(fir::FirOpBuilder &builder, mlir::Location loc,8863 llvm::ArrayRef<mlir::Value> args) {8864 assert(args.size() > 0 && "max requires at least one argument");8865 return IntrinsicLibrary{builder, loc}8866 .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),8867 args);8868}8869 8870mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc,8871 llvm::ArrayRef<mlir::Value> args) {8872 assert(args.size() > 0 && "min requires at least one argument");8873 return IntrinsicLibrary{builder, loc}8874 .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),8875 args);8876}8877 8878mlir::Value genDivC(fir::FirOpBuilder &builder, mlir::Location loc,8879 mlir::Type type, mlir::Value x, mlir::Value y) {8880 return IntrinsicLibrary{builder, loc}.genRuntimeCall("divc", type, {x, y});8881}8882 8883mlir::Value genPow(fir::FirOpBuilder &builder, mlir::Location loc,8884 mlir::Type type, mlir::Value x, mlir::Value y) {8885 // TODO: since there is no libm version of pow with integer exponent,8886 // we have to provide an alternative implementation for8887 // "precise/strict" FP mode.8888 // One option is to generate internal function with inlined8889 // implementation and mark it 'strictfp'.8890 // Another option is to implement it in Fortran runtime library8891 // (just like matmul).8892 if (type.isUnsignedInteger()) {8893 assert(x.getType().isUnsignedInteger() && y.getType().isUnsignedInteger() &&8894 "unsigned pow requires unsigned arguments");8895 return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow-unsigned", type,8896 {x, y});8897 }8898 assert(!x.getType().isUnsignedInteger() && !y.getType().isUnsignedInteger() &&8899 "non-unsigned pow requires non-unsigned arguments");8900 return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});8901}8902 8903mlir::SymbolRefAttr8904getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &builder,8905 mlir::Location loc, llvm::StringRef name,8906 mlir::FunctionType signature) {8907 return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(8908 name, signature);8909}8910} // namespace fir8911