1 //===-- Builder/IntrinsicCall.h -- lowering of intrinsics -------*- C++ -*-===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #ifndef FORTRAN_LOWER_INTRINSICCALL_H 10 #define FORTRAN_LOWER_INTRINSICCALL_H 11 12 #include "flang/Lower/AbstractConverter.h" 13 #include "flang/Optimizer/Builder/BoxValue.h" 14 #include "flang/Optimizer/Builder/FIRBuilder.h" 15 #include "flang/Optimizer/Builder/Runtime/Character.h" 16 #include "flang/Optimizer/Builder/Runtime/Numeric.h" 17 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" 18 #include "flang/Runtime/entry-names.h" 19 #include "flang/Runtime/iostat-consts.h" 20 #include "mlir/Dialect/Complex/IR/Complex.h" 21 #include "mlir/Dialect/LLVMIR/LLVMDialect.h" 22 #include "mlir/Dialect/Math/IR/Math.h" 23 #include <optional> 24 25 namespace fir { 26 27 class StatementContext; 28 struct IntrinsicHandlerEntry; 29 30 /// Lower an intrinsic call given the intrinsic \p name, its \p resultType (that 31 /// must be std::nullopt if and only if this is a subroutine call), and its 32 /// lowered arguments \p args. The returned pair contains the result value 33 /// (null mlir::Value for subroutine calls), and a boolean that indicates if 34 /// this result must be freed after use. 35 std::pair<fir::ExtendedValue, bool> 36 genIntrinsicCall(fir::FirOpBuilder &, mlir::Location, llvm::StringRef name, 37 std::optional<mlir::Type> resultType, 38 llvm::ArrayRef<fir::ExtendedValue> args, 39 Fortran::lower::AbstractConverter *converter = nullptr); 40 41 /// Same as the entry above except that instead of an intrinsic name it takes an 42 /// IntrinsicHandlerEntry obtained by a previous lookup for a handler to lower 43 /// this intrinsic (see lookupIntrinsicHandler). 44 std::pair<fir::ExtendedValue, bool> 45 genIntrinsicCall(fir::FirOpBuilder &, mlir::Location, 46 const IntrinsicHandlerEntry &, 47 std::optional<mlir::Type> resultType, 48 llvm::ArrayRef<fir::ExtendedValue> args, 49 Fortran::lower::AbstractConverter *converter = nullptr); 50 51 /// Enums used to templatize and share lowering of MIN and MAX. 52 enum class Extremum { Min, Max }; 53 54 // There are different ways to deal with NaNs in MIN and MAX. 55 // Known existing behaviors are listed below and can be selected for 56 // f18 MIN/MAX implementation. 57 enum class ExtremumBehavior { 58 // Note: the Signaling/quiet aspect of NaNs in the behaviors below are 59 // not described because there is no way to control/observe such aspect in 60 // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this 61 // aspect that are therefore currently not enforced. In the descriptions 62 // below, NaNs can be signaling or quite. Returned NaNs may be signaling 63 // if one of the input NaN was signaling but it cannot be guaranteed either. 64 // Existing compilers using an IEEE behavior (gfortran) also do not fulfill 65 // signaling/quiet requirements. 66 IeeeMinMaximumNumber, 67 // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6): 68 // If one of the argument is and number and the other is NaN, return the 69 // number. If both arguements are NaN, return NaN. 70 // Compilers: gfortran. 71 IeeeMinMaximum, 72 // IEEE minimum/maximum behavior (754-2019, section 9.6): 73 // If one of the argument is NaN, return NaN. 74 MinMaxss, 75 // x86 minss/maxss behavior: 76 // If the second argument is a number and the other is NaN, return the number. 77 // In all other cases where at least one operand is NaN, return NaN. 78 // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor. 79 PgfortranLlvm, 80 // "Opposite of" x86 minss/maxss behavior: 81 // If the first argument is a number and the other is NaN, return the 82 // number. 83 // In all other cases where at least one operand is NaN, return NaN. 84 // Compilers: xlf (only for MIN), and pgfortran (with llvm). 85 IeeeMinMaxNum 86 // IEEE minNum/maxNum behavior (754-2008, section 5.3.1): 87 // TODO: Not implemented. 88 // It is the only behavior where the signaling/quiet aspect of a NaN argument 89 // impacts if the result should be NaN or the argument that is a number. 90 // LLVM/MLIR do not provide ways to observe this aspect, so it is not 91 // possible to implement it without some target dependent runtime. 92 }; 93 94 /// Enum specifying how intrinsic argument evaluate::Expr should be 95 /// lowered to fir::ExtendedValue to be passed to genIntrinsicCall. 96 enum class LowerIntrinsicArgAs { 97 /// Lower argument to a value. Mainly intended for scalar arguments. 98 Value, 99 /// Lower argument to an address. Only valid when the argument properties are 100 /// fully defined (e.g. allocatable is allocated...). 101 Addr, 102 /// Lower argument to a box. 103 Box, 104 /// Lower argument without assuming that the argument is fully defined. 105 /// It can be used on unallocated allocatable, disassociated pointer, 106 /// or absent optional. This is meant for inquiry intrinsic arguments. 107 Inquired 108 }; 109 110 /// Define how a given intrinsic argument must be lowered. 111 struct ArgLoweringRule { 112 LowerIntrinsicArgAs lowerAs; 113 /// Value: 114 // - Numerical: 0 115 // - Logical : false 116 // - Derived/character: not possible. Need custom intrinsic lowering. 117 // Addr: 118 // - nullptr 119 // Box: 120 // - absent box 121 // AsInquired: 122 // - no-op 123 bool handleDynamicOptional; 124 }; 125 126 constexpr auto asValue = fir::LowerIntrinsicArgAs::Value; 127 constexpr auto asAddr = fir::LowerIntrinsicArgAs::Addr; 128 constexpr auto asBox = fir::LowerIntrinsicArgAs::Box; 129 constexpr auto asInquired = fir::LowerIntrinsicArgAs::Inquired; 130 131 /// Opaque class defining the argument lowering rules for all the argument of 132 /// an intrinsic. 133 struct IntrinsicArgumentLoweringRules; 134 135 // TODO error handling -> return a code or directly emit messages ? 136 struct IntrinsicLibrary { 137 138 // Constructors. 139 explicit IntrinsicLibrary( 140 fir::FirOpBuilder &builder, mlir::Location loc, 141 Fortran::lower::AbstractConverter *converter = nullptr) 142 : builder{builder}, loc{loc}, converter{converter} {} 143 IntrinsicLibrary() = delete; 144 IntrinsicLibrary(const IntrinsicLibrary &) = delete; 145 146 /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg 147 /// and expected result type \p resultType. Return the result and a boolean 148 /// that, if true, indicates that the result must be freed after use. 149 std::pair<fir::ExtendedValue, bool> 150 genIntrinsicCall(llvm::StringRef name, std::optional<mlir::Type> resultType, 151 llvm::ArrayRef<fir::ExtendedValue> arg); 152 153 /// Search a runtime function that is associated to the generic intrinsic name 154 /// and whose signature matches the intrinsic arguments and result types. 155 /// If no such runtime function is found but a runtime function associated 156 /// with the Fortran generic exists and has the same number of arguments, 157 /// conversions will be inserted before and/or after the call. This is to 158 /// mainly to allow 16 bits float support even-though little or no math 159 /// runtime is currently available for it. 160 mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type, 161 llvm::ArrayRef<mlir::Value>); 162 163 using RuntimeCallGenerator = std::function<mlir::Value( 164 fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>; 165 RuntimeCallGenerator 166 getRuntimeCallGenerator(llvm::StringRef name, 167 mlir::FunctionType soughtFuncType); 168 169 void genAbort(llvm::ArrayRef<fir::ExtendedValue>); 170 /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in 171 /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation 172 /// if the argument is an integer, into llvm intrinsics if the argument is 173 /// real and to the `hypot` math routine if the argument is of complex type. 174 mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>); 175 mlir::Value genAcosd(mlir::Type, llvm::ArrayRef<mlir::Value>); 176 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc, 177 mlir::Value, mlir::Value)> 178 fir::ExtendedValue genAdjustRtCall(mlir::Type, 179 llvm::ArrayRef<fir::ExtendedValue>); 180 mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>); 181 mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>); 182 fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 183 fir::ExtendedValue genAllocated(mlir::Type, 184 llvm::ArrayRef<fir::ExtendedValue>); 185 mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>); 186 fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 187 mlir::Value genAtanpi(mlir::Type, llvm::ArrayRef<mlir::Value>); 188 mlir::Value genAtomicAdd(mlir::Type, llvm::ArrayRef<mlir::Value>); 189 mlir::Value genAtomicAnd(mlir::Type, llvm::ArrayRef<mlir::Value>); 190 mlir::Value genAtomicOr(mlir::Type, llvm::ArrayRef<mlir::Value>); 191 mlir::Value genAtomicDec(mlir::Type, llvm::ArrayRef<mlir::Value>); 192 mlir::Value genAtomicInc(mlir::Type, llvm::ArrayRef<mlir::Value>); 193 mlir::Value genAtomicMax(mlir::Type, llvm::ArrayRef<mlir::Value>); 194 mlir::Value genAtomicMin(mlir::Type, llvm::ArrayRef<mlir::Value>); 195 mlir::Value genAtomicSub(mlir::Type, llvm::ArrayRef<mlir::Value>); 196 fir::ExtendedValue 197 genCommandArgumentCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 198 mlir::Value genAsind(mlir::Type, llvm::ArrayRef<mlir::Value>); 199 fir::ExtendedValue genAssociated(mlir::Type, 200 llvm::ArrayRef<fir::ExtendedValue>); 201 mlir::Value genAtand(mlir::Type, llvm::ArrayRef<mlir::Value>); 202 fir::ExtendedValue genBesselJn(mlir::Type, 203 llvm::ArrayRef<fir::ExtendedValue>); 204 fir::ExtendedValue genBesselYn(mlir::Type, 205 llvm::ArrayRef<fir::ExtendedValue>); 206 template <mlir::arith::CmpIPredicate pred> 207 mlir::Value genBitwiseCompare(mlir::Type resultType, 208 llvm::ArrayRef<mlir::Value> args); 209 210 mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>); 211 mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>); 212 fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 213 fir::ExtendedValue genChdir(std::optional<mlir::Type> resultType, 214 llvm::ArrayRef<fir::ExtendedValue>); 215 template <mlir::arith::CmpIPredicate pred> 216 fir::ExtendedValue genCharacterCompare(mlir::Type, 217 llvm::ArrayRef<fir::ExtendedValue>); 218 mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>); 219 mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>); 220 fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 221 void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>); 222 fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 223 fir::ExtendedValue genCAssociatedCFunPtr(mlir::Type, 224 llvm::ArrayRef<fir::ExtendedValue>); 225 fir::ExtendedValue genCAssociatedCPtr(mlir::Type, 226 llvm::ArrayRef<fir::ExtendedValue>); 227 fir::ExtendedValue genCDevLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 228 mlir::Value genErfcScaled(mlir::Type resultType, 229 llvm::ArrayRef<mlir::Value> args); 230 void genCFPointer(llvm::ArrayRef<fir::ExtendedValue>); 231 void genCFProcPointer(llvm::ArrayRef<fir::ExtendedValue>); 232 fir::ExtendedValue genCFunLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 233 fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 234 template <mlir::arith::CmpIPredicate pred> 235 fir::ExtendedValue genCPtrCompare(mlir::Type, 236 llvm::ArrayRef<fir::ExtendedValue>); 237 mlir::Value genCosd(mlir::Type, llvm::ArrayRef<mlir::Value>); 238 void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>); 239 mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>); 240 fir::ExtendedValue genDotProduct(mlir::Type, 241 llvm::ArrayRef<fir::ExtendedValue>); 242 mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>); 243 mlir::Value genDshiftl(mlir::Type, llvm::ArrayRef<mlir::Value>); 244 mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>); 245 fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 246 void genExit(llvm::ArrayRef<fir::ExtendedValue>); 247 void genExecuteCommandLine(mlir::ArrayRef<fir::ExtendedValue> args); 248 fir::ExtendedValue genEtime(std::optional<mlir::Type>, 249 mlir::ArrayRef<fir::ExtendedValue> args); 250 mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>); 251 fir::ExtendedValue genExtendsTypeOf(mlir::Type, 252 llvm::ArrayRef<fir::ExtendedValue>); 253 template <Extremum, ExtremumBehavior> 254 mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>); 255 mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>); 256 mlir::Value genFraction(mlir::Type resultType, 257 mlir::ArrayRef<mlir::Value> args); 258 void genFree(mlir::ArrayRef<fir::ExtendedValue> args); 259 fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType, 260 llvm::ArrayRef<fir::ExtendedValue> args); 261 void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args); 262 mlir::Value genGetPID(mlir::Type resultType, 263 llvm::ArrayRef<mlir::Value> args); 264 void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args); 265 void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>); 266 mlir::Value genGetGID(mlir::Type resultType, 267 llvm::ArrayRef<mlir::Value> args); 268 mlir::Value genGetUID(mlir::Type resultType, 269 llvm::ArrayRef<mlir::Value> args); 270 fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 271 mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>); 272 fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 273 mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>); 274 mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>); 275 mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>); 276 fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 277 fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 278 mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef<mlir::Value>); 279 mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>); 280 void genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>); 281 void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>); 282 template <bool isGet, bool isModes> 283 void genIeeeGetOrSetModesOrStatus(llvm::ArrayRef<fir::ExtendedValue>); 284 void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>); 285 void genIeeeGetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>); 286 mlir::Value genIeeeInt(mlir::Type, llvm::ArrayRef<mlir::Value>); 287 mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>); 288 mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>); 289 mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef<mlir::Value>); 290 mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef<mlir::Value>); 291 mlir::Value genIeeeLogb(mlir::Type, mlir::ArrayRef<mlir::Value>); 292 template <bool isMax, bool isNum, bool isMag> 293 mlir::Value genIeeeMaxMin(mlir::Type, llvm::ArrayRef<mlir::Value>); 294 template <mlir::arith::CmpFPredicate pred> 295 mlir::Value genIeeeQuietCompare(mlir::Type resultType, 296 llvm::ArrayRef<mlir::Value>); 297 mlir::Value genIeeeReal(mlir::Type, llvm::ArrayRef<mlir::Value>); 298 mlir::Value genIeeeRem(mlir::Type, llvm::ArrayRef<mlir::Value>); 299 mlir::Value genIeeeRint(mlir::Type, llvm::ArrayRef<mlir::Value>); 300 template <bool isFlag> 301 void genIeeeSetFlagOrHaltingMode(llvm::ArrayRef<fir::ExtendedValue>); 302 void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>); 303 void genIeeeSetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>); 304 template <mlir::arith::CmpFPredicate pred> 305 mlir::Value genIeeeSignalingCompare(mlir::Type resultType, 306 llvm::ArrayRef<mlir::Value>); 307 mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>); 308 fir::ExtendedValue genIeeeSupportFlag(mlir::Type, 309 llvm::ArrayRef<fir::ExtendedValue>); 310 fir::ExtendedValue genIeeeSupportHalting(mlir::Type, 311 llvm::ArrayRef<fir::ExtendedValue>); 312 mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>); 313 template <mlir::arith::CmpIPredicate pred> 314 mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>); 315 mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef<mlir::Value>); 316 mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef<mlir::Value>); 317 mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>); 318 fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 319 mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>); 320 fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 321 fir::ExtendedValue genIsContiguous(mlir::Type, 322 llvm::ArrayRef<fir::ExtendedValue>); 323 template <Fortran::runtime::io::Iostat value> 324 mlir::Value genIsIostatValue(mlir::Type, llvm::ArrayRef<mlir::Value>); 325 mlir::Value genIsFPClass(mlir::Type, llvm::ArrayRef<mlir::Value>, 326 int fpclass); 327 mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>); 328 mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>); 329 fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 330 mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>); 331 fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 332 fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 333 fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 334 mlir::Value genMalloc(mlir::Type, llvm::ArrayRef<mlir::Value>); 335 template <typename Shift> 336 mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>); 337 fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 338 fir::ExtendedValue genMatmulTranspose(mlir::Type, 339 llvm::ArrayRef<fir::ExtendedValue>); 340 fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 341 fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 342 fir::ExtendedValue genMerge(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 343 mlir::Value genMergeBits(mlir::Type, llvm::ArrayRef<mlir::Value>); 344 fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 345 fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 346 mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>); 347 mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>); 348 void genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue>); 349 void genMvbits(llvm::ArrayRef<fir::ExtendedValue>); 350 enum class NearestProc { Nearest, NextAfter, NextDown, NextUp }; 351 template <NearestProc> 352 mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>); 353 mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>); 354 fir::ExtendedValue genNorm2(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 355 mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>); 356 fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 357 fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 358 fir::ExtendedValue genParity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 359 mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>); 360 mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>); 361 fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 362 fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 363 void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>); 364 void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>); 365 void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>); 366 fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 367 fir::ExtendedValue genReduceDim(mlir::Type, 368 llvm::ArrayRef<fir::ExtendedValue>); 369 fir::ExtendedValue genRename(std::optional<mlir::Type>, 370 mlir::ArrayRef<fir::ExtendedValue>); 371 fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 372 fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 373 mlir::Value genRRSpacing(mlir::Type resultType, 374 llvm::ArrayRef<mlir::Value> args); 375 fir::ExtendedValue genSameTypeAs(mlir::Type, 376 llvm::ArrayRef<fir::ExtendedValue>); 377 mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>); 378 fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 379 fir::ExtendedValue genSecond(std::optional<mlir::Type>, 380 mlir::ArrayRef<fir::ExtendedValue>); 381 fir::ExtendedValue genSelectedCharKind(mlir::Type, 382 llvm::ArrayRef<fir::ExtendedValue>); 383 mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef<mlir::Value>); 384 mlir::Value genSelectedLogicalKind(mlir::Type, llvm::ArrayRef<mlir::Value>); 385 mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef<mlir::Value>); 386 mlir::Value genSetExponent(mlir::Type resultType, 387 llvm::ArrayRef<mlir::Value> args); 388 fir::ExtendedValue genShape(mlir::Type resultType, 389 llvm::ArrayRef<fir::ExtendedValue>); 390 template <typename Shift> 391 mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>); 392 mlir::Value genShiftA(mlir::Type resultType, llvm::ArrayRef<mlir::Value>); 393 mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>); 394 mlir::Value genSind(mlir::Type, llvm::ArrayRef<mlir::Value>); 395 fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 396 fir::ExtendedValue genSizeOf(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 397 mlir::Value genSpacing(mlir::Type resultType, 398 llvm::ArrayRef<mlir::Value> args); 399 fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 400 fir::ExtendedValue genStorageSize(mlir::Type, 401 llvm::ArrayRef<fir::ExtendedValue>); 402 fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 403 void genSignalSubroutine(llvm::ArrayRef<fir::ExtendedValue>); 404 void genSleep(llvm::ArrayRef<fir::ExtendedValue>); 405 void genSyncThreads(llvm::ArrayRef<fir::ExtendedValue>); 406 mlir::Value genSyncThreadsAnd(mlir::Type, llvm::ArrayRef<mlir::Value>); 407 mlir::Value genSyncThreadsCount(mlir::Type, llvm::ArrayRef<mlir::Value>); 408 mlir::Value genSyncThreadsOr(mlir::Type, llvm::ArrayRef<mlir::Value>); 409 fir::ExtendedValue genSystem(std::optional<mlir::Type>, 410 mlir::ArrayRef<fir::ExtendedValue> args); 411 void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>); 412 mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>); 413 mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>); 414 fir::ExtendedValue genTransfer(mlir::Type, 415 llvm::ArrayRef<fir::ExtendedValue>); 416 fir::ExtendedValue genTranspose(mlir::Type, 417 llvm::ArrayRef<fir::ExtendedValue>); 418 void genThreadFence(llvm::ArrayRef<fir::ExtendedValue>); 419 void genThreadFenceBlock(llvm::ArrayRef<fir::ExtendedValue>); 420 void genThreadFenceSystem(llvm::ArrayRef<fir::ExtendedValue>); 421 fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 422 fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 423 fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 424 fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>); 425 426 /// Implement all conversion functions like DBLE, the first argument is 427 /// the value to convert. There may be an additional KIND arguments that 428 /// is ignored because this is already reflected in the result type. 429 mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>); 430 431 /// In the template helper below: 432 /// - "FN func" is a callback to generate the related intrinsic runtime call. 433 /// - "FD funcDim" is a callback to generate the "dim" runtime call. 434 /// - "FC funcChar" is a callback to generate the character runtime call. 435 /// Helper for MinLoc/MaxLoc. 436 template <typename FN, typename FD> 437 fir::ExtendedValue genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg, 438 mlir::Type, 439 llvm::ArrayRef<fir::ExtendedValue>); 440 template <typename FN, typename FD, typename FC> 441 /// Helper for MinVal/MaxVal. 442 fir::ExtendedValue genExtremumVal(FN func, FD funcDim, FC funcChar, 443 llvm::StringRef errMsg, 444 mlir::Type resultType, 445 llvm::ArrayRef<fir::ExtendedValue> args); 446 /// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions 447 template <typename FN, typename FD> 448 fir::ExtendedValue genReduction(FN func, FD funcDim, llvm::StringRef errMsg, 449 mlir::Type resultType, 450 llvm::ArrayRef<fir::ExtendedValue> args); 451 452 /// Generate code to raise \p excepts if \p cond is absent, 453 /// or present and true. 454 void genRaiseExcept(int excepts, mlir::Value cond = {}); 455 456 /// Generate a quiet NaN of a given floating point type. 457 mlir::Value genQNan(mlir::Type resultType); 458 459 /// Define the different FIR generators that can be mapped to intrinsic to 460 /// generate the related code. 461 using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs); 462 using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim); 463 using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime); 464 /// The generator for intrinsic that has both function and subroutine form. 465 using DualGenerator = decltype(&IntrinsicLibrary::genEtime); 466 using Generator = std::variant<ElementalGenerator, ExtendedGenerator, 467 SubroutineGenerator, DualGenerator>; 468 469 /// All generators can be outlined. This will build a function named 470 /// "fir."+ <generic name> + "." + <result type code> and generate the 471 /// intrinsic implementation inside instead of at the intrinsic call sites. 472 /// This can be used to keep the FIR more readable. Only one function will 473 /// be generated for all the similar calls in a program. 474 /// If the Generator is nullptr, the wrapper uses genRuntimeCall. 475 template <typename GeneratorType> 476 mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name, 477 mlir::Type resultType, 478 llvm::ArrayRef<mlir::Value> args); 479 template <typename GeneratorType> 480 fir::ExtendedValue 481 outlineInExtendedWrapper(GeneratorType, llvm::StringRef name, 482 std::optional<mlir::Type> resultType, 483 llvm::ArrayRef<fir::ExtendedValue> args); 484 485 template <typename GeneratorType> 486 mlir::func::FuncOp getWrapper(GeneratorType, llvm::StringRef name, 487 mlir::FunctionType, 488 bool loadRefArguments = false); 489 490 /// Generate calls to ElementalGenerator, handling the elemental aspects 491 template <typename GeneratorType> 492 fir::ExtendedValue 493 genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType, 494 llvm::ArrayRef<fir::ExtendedValue> args, bool outline); 495 496 /// Helper to invoke code generator for the intrinsics given arguments. 497 mlir::Value invokeGenerator(ElementalGenerator generator, 498 mlir::Type resultType, 499 llvm::ArrayRef<mlir::Value> args); 500 mlir::Value invokeGenerator(RuntimeCallGenerator generator, 501 mlir::Type resultType, 502 llvm::ArrayRef<mlir::Value> args); 503 mlir::Value invokeGenerator(ExtendedGenerator generator, 504 mlir::Type resultType, 505 llvm::ArrayRef<mlir::Value> args); 506 mlir::Value invokeGenerator(SubroutineGenerator generator, 507 llvm::ArrayRef<mlir::Value> args); 508 mlir::Value invokeGenerator(DualGenerator generator, 509 llvm::ArrayRef<mlir::Value> args); 510 mlir::Value invokeGenerator(DualGenerator generator, mlir::Type resultType, 511 llvm::ArrayRef<mlir::Value> args); 512 513 /// Get pointer to unrestricted intrinsic. Generate the related unrestricted 514 /// intrinsic if it is not defined yet. 515 mlir::SymbolRefAttr 516 getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name, 517 mlir::FunctionType signature); 518 519 /// Helper function for generating code clean-up for result descriptors 520 fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox, 521 mlir::Type resultType, 522 llvm::StringRef errMsg); 523 524 void setResultMustBeFreed() { resultMustBeFreed = true; } 525 526 fir::FirOpBuilder &builder; 527 mlir::Location loc; 528 bool resultMustBeFreed = false; 529 Fortran::lower::AbstractConverter *converter = nullptr; 530 }; 531 532 struct IntrinsicDummyArgument { 533 const char *name = nullptr; 534 fir::LowerIntrinsicArgAs lowerAs = fir::LowerIntrinsicArgAs::Value; 535 bool handleDynamicOptional = false; 536 }; 537 538 /// This is shared by intrinsics and intrinsic module procedures. 539 struct IntrinsicArgumentLoweringRules { 540 /// There is no more than 7 non repeated arguments in Fortran intrinsics. 541 IntrinsicDummyArgument args[7]; 542 constexpr bool hasDefaultRules() const { return args[0].name == nullptr; } 543 }; 544 545 /// Structure describing what needs to be done to lower intrinsic or intrinsic 546 /// module procedure "name". 547 struct IntrinsicHandler { 548 const char *name; 549 IntrinsicLibrary::Generator generator; 550 // The following may be omitted in the table below. 551 fir::IntrinsicArgumentLoweringRules argLoweringRules = {}; 552 bool isElemental = true; 553 /// Code heavy intrinsic can be outlined to make FIR 554 /// more readable. 555 bool outline = false; 556 }; 557 558 struct RuntimeFunction { 559 // llvm::StringRef comparison operator are not constexpr, so use string_view. 560 using Key = std::string_view; 561 // Needed for implicit compare with keys. 562 constexpr operator Key() const { return key; } 563 Key key; // intrinsic name 564 565 // Name of a runtime function that implements the operation. 566 llvm::StringRef symbol; 567 fir::runtime::FuncTypeBuilderFunc typeGenerator; 568 }; 569 570 struct MathOperation { 571 // Callback type for generating lowering for a math operation. 572 using MathGeneratorTy = mlir::Value (*)(fir::FirOpBuilder &, mlir::Location, 573 const MathOperation &, 574 mlir::FunctionType, 575 llvm::ArrayRef<mlir::Value>); 576 577 // Overrides fir::runtime::FuncTypeBuilderFunc to add FirOpBuilder argument. 578 using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *, 579 fir::FirOpBuilder &); 580 581 // llvm::StringRef comparison operator are not constexpr, so use string_view. 582 using Key = std::string_view; 583 // Needed for implicit compare with keys. 584 constexpr operator Key() const { return key; } 585 // Intrinsic name. 586 Key key; 587 588 // Name of a runtime function that implements the operation. 589 llvm::StringRef runtimeFunc; 590 FuncTypeBuilderFunc typeGenerator; 591 592 // A callback to generate FIR for the intrinsic defined by 'key'. 593 // A callback may generate either dedicated MLIR operation(s) or 594 // a function call to a runtime function with name defined by 595 // 'runtimeFunc'. 596 MathGeneratorTy funcGenerator; 597 }; 598 599 // Enum of most supported intrinsic argument or return types. 600 enum class ParamTypeId { 601 Void, 602 Address, // pointer (to an [array of] Integers of some kind) 603 Integer, 604 Real, 605 Complex, 606 IntegerVector, 607 UnsignedVector, 608 RealVector, 609 }; 610 611 // Helper function to get length of a 16-byte vector of element type eleTy. 612 static int getVecLen(mlir::Type eleTy) { 613 assert((mlir::isa<mlir::IntegerType>(eleTy) || 614 mlir::isa<mlir::FloatType>(eleTy)) && 615 "unsupported vector element type"); 616 return 16 / (eleTy.getIntOrFloatBitWidth() / 8); 617 } 618 619 template <ParamTypeId t, int k> 620 struct ParamType { 621 // Supported kinds can be checked with static asserts at compile time. 622 static_assert(t != ParamTypeId::Integer || k == 1 || k == 2 || k == 4 || 623 k == 8, 624 "Unsupported integer kind"); 625 static_assert(t != ParamTypeId::Real || k == 4 || k == 8 || k == 10 || 626 k == 16, 627 "Unsupported real kind"); 628 static_assert(t != ParamTypeId::Complex || k == 2 || k == 3 || k == 4 || 629 k == 8 || k == 10 || k == 16, 630 "Unsupported complex kind"); 631 632 static const ParamTypeId ty = t; 633 static const int kind = k; 634 }; 635 636 // Namespace encapsulating type definitions for parameter types. 637 namespace Ty { 638 using Void = ParamType<ParamTypeId::Void, 0>; 639 template <int k> 640 using Address = ParamType<ParamTypeId::Address, k>; 641 template <int k> 642 using Integer = ParamType<ParamTypeId::Integer, k>; 643 template <int k> 644 using Real = ParamType<ParamTypeId::Real, k>; 645 template <int k> 646 using Complex = ParamType<ParamTypeId::Complex, k>; 647 template <int k> 648 using IntegerVector = ParamType<ParamTypeId::IntegerVector, k>; 649 template <int k> 650 using UnsignedVector = ParamType<ParamTypeId::UnsignedVector, k>; 651 template <int k> 652 using RealVector = ParamType<ParamTypeId::RealVector, k>; 653 } // namespace Ty 654 655 // Helper function that generates most types that are supported for intrinsic 656 // arguments and return type. Used by `genFuncType` to generate function 657 // types for most of the intrinsics. 658 static inline mlir::Type getTypeHelper(mlir::MLIRContext *context, 659 fir::FirOpBuilder &builder, 660 ParamTypeId typeId, int kind) { 661 mlir::Type r; 662 unsigned bits{0}; 663 switch (typeId) { 664 case ParamTypeId::Void: 665 llvm::report_fatal_error("can not get type of void"); 666 break; 667 case ParamTypeId::Address: 668 bits = builder.getKindMap().getIntegerBitsize(kind); 669 assert(bits != 0 && "failed to convert address kind to integer bitsize"); 670 r = fir::ReferenceType::get(mlir::IntegerType::get(context, bits)); 671 break; 672 case ParamTypeId::Integer: 673 case ParamTypeId::IntegerVector: 674 bits = builder.getKindMap().getIntegerBitsize(kind); 675 assert(bits != 0 && "failed to convert kind to integer bitsize"); 676 r = mlir::IntegerType::get(context, bits); 677 break; 678 case ParamTypeId::UnsignedVector: 679 bits = builder.getKindMap().getIntegerBitsize(kind); 680 assert(bits != 0 && "failed to convert kind to unsigned bitsize"); 681 r = mlir::IntegerType::get(context, bits, mlir::IntegerType::Unsigned); 682 break; 683 case ParamTypeId::Real: 684 case ParamTypeId::RealVector: 685 r = builder.getRealType(kind); 686 break; 687 case ParamTypeId::Complex: 688 r = mlir::ComplexType::get(builder.getRealType(kind)); 689 break; 690 } 691 692 switch (typeId) { 693 case ParamTypeId::Void: 694 case ParamTypeId::Address: 695 case ParamTypeId::Integer: 696 case ParamTypeId::Real: 697 case ParamTypeId::Complex: 698 break; 699 case ParamTypeId::IntegerVector: 700 case ParamTypeId::UnsignedVector: 701 case ParamTypeId::RealVector: 702 // convert to vector type 703 r = fir::VectorType::get(getVecLen(r), r); 704 } 705 return r; 706 } 707 708 // Generic function type generator that supports most of the function types 709 // used by intrinsics. 710 template <typename TyR, typename... ArgTys> 711 static inline mlir::FunctionType genFuncType(mlir::MLIRContext *context, 712 fir::FirOpBuilder &builder) { 713 llvm::SmallVector<ParamTypeId> argTys = {ArgTys::ty...}; 714 llvm::SmallVector<int> argKinds = {ArgTys::kind...}; 715 llvm::SmallVector<mlir::Type> argTypes; 716 717 for (size_t i = 0; i < argTys.size(); ++i) { 718 argTypes.push_back(getTypeHelper(context, builder, argTys[i], argKinds[i])); 719 } 720 721 if (TyR::ty == ParamTypeId::Void) 722 return mlir::FunctionType::get(context, argTypes, std::nullopt); 723 724 auto resType = getTypeHelper(context, builder, TyR::ty, TyR::kind); 725 return mlir::FunctionType::get(context, argTypes, {resType}); 726 } 727 728 /// Entry into the tables describing how an intrinsic must be lowered. 729 struct IntrinsicHandlerEntry { 730 using RuntimeGeneratorRange = 731 std::pair<const MathOperation *, const MathOperation *>; 732 IntrinsicHandlerEntry(const IntrinsicHandler *handler) : entry{handler} { 733 assert(handler && "handler must not be nullptr"); 734 }; 735 IntrinsicHandlerEntry(RuntimeGeneratorRange rt) : entry{rt} {}; 736 const IntrinsicArgumentLoweringRules *getArgumentLoweringRules() const; 737 std::variant<const IntrinsicHandler *, RuntimeGeneratorRange> entry; 738 }; 739 740 //===----------------------------------------------------------------------===// 741 // Helper functions for argument handling. 742 //===----------------------------------------------------------------------===// 743 static inline mlir::Type getConvertedElementType(mlir::MLIRContext *context, 744 mlir::Type eleTy) { 745 if (mlir::isa<mlir::IntegerType>(eleTy) && !eleTy.isSignlessInteger()) { 746 const auto intTy{mlir::dyn_cast<mlir::IntegerType>(eleTy)}; 747 auto newEleTy{mlir::IntegerType::get(context, intTy.getWidth())}; 748 return newEleTy; 749 } 750 return eleTy; 751 } 752 753 static inline llvm::SmallVector<mlir::Value, 4> 754 getBasesForArgs(llvm::ArrayRef<fir::ExtendedValue> args) { 755 llvm::SmallVector<mlir::Value, 4> baseVec; 756 for (auto arg : args) 757 baseVec.push_back(getBase(arg)); 758 return baseVec; 759 } 760 761 static inline llvm::SmallVector<mlir::Type, 4> 762 getTypesForArgs(llvm::ArrayRef<mlir::Value> args) { 763 llvm::SmallVector<mlir::Type, 4> typeVec; 764 for (auto arg : args) 765 typeVec.push_back(arg.getType()); 766 return typeVec; 767 } 768 769 mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc, 770 const MathOperation &mathOp, 771 mlir::FunctionType libFuncType, 772 llvm::ArrayRef<mlir::Value> args); 773 774 template <typename T> 775 mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc, 776 const MathOperation &mathOp, 777 mlir::FunctionType mathLibFuncType, 778 llvm::ArrayRef<mlir::Value> args); 779 780 template <typename T> 781 mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc, 782 const MathOperation &mathOp, 783 mlir::FunctionType mathLibFuncType, 784 llvm::ArrayRef<mlir::Value> args); 785 786 mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder, 787 mlir::Location loc, 788 const MathOperation &mathOp, 789 mlir::FunctionType libFuncType, 790 llvm::ArrayRef<mlir::Value> args); 791 792 /// Lookup for a handler or runtime call generator to lower intrinsic 793 /// \p intrinsicName. 794 std::optional<IntrinsicHandlerEntry> 795 lookupIntrinsicHandler(fir::FirOpBuilder &, llvm::StringRef intrinsicName, 796 std::optional<mlir::Type> resultType); 797 798 /// Generate a TODO error message for an as yet unimplemented intrinsic. 799 void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name); 800 801 /// Return argument lowering rules for an intrinsic. 802 /// Returns a nullptr if all the intrinsic arguments should be lowered by value. 803 const IntrinsicArgumentLoweringRules * 804 getIntrinsicArgumentLowering(llvm::StringRef intrinsicName); 805 806 /// Return how argument \p argName should be lowered given the rules for the 807 /// intrinsic function. The argument names are the one defined by the standard. 808 ArgLoweringRule lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &, 809 unsigned position); 810 811 /// Return place-holder for absent intrinsic arguments. 812 fir::ExtendedValue getAbsentIntrinsicArgument(); 813 814 /// Get SymbolRefAttr of runtime (or wrapper function containing inlined 815 // implementation) of an unrestricted intrinsic (defined by its signature 816 // and generic name) 817 mlir::SymbolRefAttr 818 getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &, mlir::Location, 819 llvm::StringRef name, 820 mlir::FunctionType signature); 821 822 //===----------------------------------------------------------------------===// 823 // Direct access to intrinsics that may be used by lowering outside 824 // of intrinsic call lowering. 825 //===----------------------------------------------------------------------===// 826 827 /// Generate maximum. There must be at least one argument and all arguments 828 /// must have the same type. 829 mlir::Value genMax(fir::FirOpBuilder &, mlir::Location, 830 llvm::ArrayRef<mlir::Value> args); 831 832 /// Generate minimum. Same constraints as genMax. 833 mlir::Value genMin(fir::FirOpBuilder &, mlir::Location, 834 llvm::ArrayRef<mlir::Value> args); 835 836 /// Generate Complex divide with the given expected 837 /// result type. 838 mlir::Value genDivC(fir::FirOpBuilder &builder, mlir::Location loc, 839 mlir::Type resultType, mlir::Value x, mlir::Value y); 840 841 /// Generate power function x**y with the given expected 842 /// result type. 843 mlir::Value genPow(fir::FirOpBuilder &, mlir::Location, mlir::Type resultType, 844 mlir::Value x, mlir::Value y); 845 846 } // namespace fir 847 848 #endif // FORTRAN_LOWER_INTRINSICCALL_H 849