diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h deleted file mode 100644 --- a/flang/include/flang/Lower/IntrinsicCall.h +++ /dev/null @@ -1,67 +0,0 @@ -//===-- Lower/IntrinsicCall.h -- lowering of intrinsics ---------*- C++ -*-===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// - -#ifndef FORTRAN_LOWER_INTRINSICCALL_H -#define FORTRAN_LOWER_INTRINSICCALL_H - -#include "flang/Optimizer/Builder/FIRBuilder.h" - -namespace fir { -class ExtendedValue; -} - -namespace Fortran::lower { - -// TODO: Expose interface to get specific intrinsic function address. -// TODO: Handle intrinsic subroutine. -// TODO: Intrinsics that do not require their arguments to be defined -// (e.g shape inquiries) might not fit in the current interface that -// requires mlir::Value to be provided. -// TODO: Error handling interface ? -// TODO: Implementation is incomplete. Many intrinsics to tbd. - -/// Helper for building calls to intrinsic functions in the runtime support -/// libraries. - -/// Generate the FIR+MLIR operations for the generic intrinsic \p name -/// with arguments \p args and expected result type \p resultType. -/// Returned mlir::Value is the returned Fortran intrinsic value. -fir::ExtendedValue genIntrinsicCall(fir::FirOpBuilder &, mlir::Location, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args); - -/// Get SymbolRefAttr of runtime (or wrapper function containing inlined -// implementation) of an unrestricted intrinsic (defined by its signature -// and generic name) -mlir::SymbolRefAttr -getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &, mlir::Location, - llvm::StringRef name, - mlir::FunctionType signature); - -//===--------------------------------------------------------------------===// -// Direct access to intrinsics that may be used by lowering outside -// of intrinsic call lowering. -//===--------------------------------------------------------------------===// - -/// Generate maximum. There must be at least one argument and all arguments -/// must have the same type. -mlir::Value genMax(fir::FirOpBuilder &, mlir::Location, - llvm::ArrayRef args); - -/// Generate minimum. Same constraints as genMax. -mlir::Value genMin(fir::FirOpBuilder &, mlir::Location, - llvm::ArrayRef args); - -/// Generate power function x**y with given the expected -/// result type. -mlir::Value genPow(fir::FirOpBuilder &, mlir::Location, mlir::Type resultType, - mlir::Value x, mlir::Value y); - -} // namespace Fortran::lower - -#endif // FORTRAN_LOWER_INTRINSICCALL_H diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -5,7 +5,6 @@ CharacterRuntime.cpp Coarray.cpp ConvertType.cpp - IntrinsicCall.cpp IO.cpp Mangler.cpp OpenACC.cpp diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -8,7 +8,6 @@ #include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ConvertType.h" -#include "flang/Lower/IntrinsicCall.h" #include "flang/Optimizer/Builder/DoLoopHelper.h" //===----------------------------------------------------------------------===// @@ -244,9 +243,12 @@ // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder // if needed. mlir::Value copyCount = lhs.getLen(); - if (!compileTimeSameLength) + if (!compileTimeSameLength) { + auto cmp = builder.create(loc, arith::CmpIPredicate::slt, + lhs.getLen(), rhs.getLen()); copyCount = - Fortran::lower::genMin(builder, loc, {lhs.getLen(), rhs.getLen()}); + builder.create(loc, cmp, lhs.getLen(), rhs.getLen()); + } fir::CharBoxValue safeRhs = rhs; if (needToMaterialize(rhs)) { diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp deleted file mode 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ /dev/null @@ -1,1306 +0,0 @@ -//===-- IntrinsicCall.cpp -------------------------------------------------===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// -// -// Helper routines for constructing the FIR dialect of MLIR. As FIR is a -// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding -// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this -// module. -// -//===----------------------------------------------------------------------===// - -#include "flang/Lower/IntrinsicCall.h" -#include "RTBuilder.h" -#include "flang/Common/static-multimap-view.h" -#include "flang/Lower/CharacterExpr.h" -#include "flang/Lower/ConvertType.h" -#include "flang/Lower/Mangler.h" -#include "flang/Lower/Runtime.h" -#include "flang/Optimizer/Builder/Complex.h" -#include "flang/Optimizer/Builder/FIRBuilder.h" -#include "llvm/Support/CommandLine.h" -#include "llvm/Support/ErrorHandling.h" -#include -#include -#include - -#define PGMATH_DECLARE -#include "flang/Evaluate/pgmath.h.inc" - -/// This file implements lowering of Fortran intrinsic procedures. -/// Intrinsics are lowered to a mix of FIR and MLIR operations as -/// well as call to runtime functions or LLVM intrinsics. - -/// Lowering of intrinsic procedure calls is based on a map that associates -/// Fortran intrinsic generic names to FIR generator functions. -/// All generator functions are member functions of the IntrinsicLibrary class -/// and have the same interface. -/// If no generator is given for an intrinsic name, a math runtime library -/// is searched for an implementation and, if a runtime function is found, -/// a call is generated for it. LLVM intrinsics are handled as a math -/// runtime library here. - -/// Enums used to templatize and share lowering of MIN and MAX. -enum class Extremum { Min, Max }; - -// There are different ways to deal with NaNs in MIN and MAX. -// Known existing behaviors are listed below and can be selected for -// f18 MIN/MAX implementation. -enum class ExtremumBehavior { - // Note: the Signaling/quiet aspect of NaNs in the behaviors below are - // not described because there is no way to control/observe such aspect in - // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this - // aspect that are therefore currently not enforced. In the descriptions - // below, NaNs can be signaling or quite. Returned NaNs may be signaling - // if one of the input NaN was signaling but it cannot be guaranteed either. - // Existing compilers using an IEEE behavior (gfortran) also do not fulfill - // signaling/quiet requirements. - IeeeMinMaximumNumber, - // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6): - // If one of the argument is and number and the other is NaN, return the - // number. If both arguements are NaN, return NaN. - // Compilers: gfortran. - IeeeMinMaximum, - // IEEE minimum/maximum behavior (754-2019, section 9.6): - // If one of the argument is NaN, return NaN. - MinMaxss, - // x86 minss/maxss behavior: - // If the second argument is a number and the other is NaN, return the number. - // In all other cases where at least one operand is NaN, return NaN. - // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor. - PgfortranLlvm, - // "Opposite of" x86 minss/maxss behavior: - // If the first argument is a number and the other is NaN, return the - // number. - // In all other cases where at least one operand is NaN, return NaN. - // Compilers: xlf (only for MIN), and pgfortran (with llvm). - IeeeMinMaxNum - // IEEE minNum/maxNum behavior (754-2008, section 5.3.1): - // TODO: Not implemented. - // It is the only behavior where the signaling/quiet aspect of a NaN argument - // impacts if the result should be NaN or the argument that is a number. - // LLVM/MLIR do not provide ways to observe this aspect, so it is not - // possible to implement it without some target dependent runtime. -}; - -// TODO error handling -> return a code or directly emit messages ? -struct IntrinsicLibrary { - - // Constructors. - explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc) - : builder{builder}, loc{loc} {} - IntrinsicLibrary() = delete; - IntrinsicLibrary(const IntrinsicLibrary &) = delete; - - /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg - /// and expected result type \p resultType. - fir::ExtendedValue genIntrinsicCall(llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef arg); - - /// Search a runtime function that is associated to the generic intrinsic name - /// and whose signature matches the intrinsic arguments and result types. - /// If no such runtime function is found but a runtime function associated - /// with the Fortran generic exists and has the same number of arguments, - /// conversions will be inserted before and/or after the call. This is to - /// mainly to allow 16 bits float support even-though little or no math - /// runtime is currently available for it. - mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type, - llvm::ArrayRef); - - using RuntimeCallGenerator = std::function)>; - RuntimeCallGenerator - getRuntimeCallGenerator(llvm::StringRef name, - mlir::FunctionType soughtFuncType); - - mlir::Value genAbs(mlir::Type, llvm::ArrayRef); - mlir::Value genAimag(mlir::Type, llvm::ArrayRef); - mlir::Value genAint(mlir::Type, llvm::ArrayRef); - mlir::Value genAnint(mlir::Type, llvm::ArrayRef); - mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); - mlir::Value genConjg(mlir::Type, llvm::ArrayRef); - mlir::Value genDim(mlir::Type, llvm::ArrayRef); - mlir::Value genDprod(mlir::Type, llvm::ArrayRef); - template - mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); - mlir::Value genFloor(mlir::Type, llvm::ArrayRef); - mlir::Value genIAnd(mlir::Type, llvm::ArrayRef); - mlir::Value genIchar(mlir::Type, llvm::ArrayRef); - mlir::Value genIEOr(mlir::Type, llvm::ArrayRef); - mlir::Value genIOr(mlir::Type, llvm::ArrayRef); - fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); - fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef); - mlir::Value genMerge(mlir::Type, llvm::ArrayRef); - mlir::Value genMod(mlir::Type, llvm::ArrayRef); - mlir::Value genNint(mlir::Type, llvm::ArrayRef); - mlir::Value genSign(mlir::Type, llvm::ArrayRef); - /// Implement all conversion functions like DBLE, the first argument is - /// the value to convert. There may be an additional KIND arguments that - /// is ignored because this is already reflected in the result type. - mlir::Value genConversion(mlir::Type, llvm::ArrayRef); - - /// Define the different FIR generators that can be mapped to intrinsic to - /// generate the related code. - using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs); - using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim); - using Generator = std::variant; - - /// All generators can be outlined. This will build a function named - /// "fir."+ + "." + and generate the - /// intrinsic implementation inside instead of at the intrinsic call sites. - /// This can be used to keep the FIR more readable. Only one function will - /// be generated for all the similar calls in a program. - /// If the Generator is nullptr, the wrapper uses genRuntimeCall. - template - mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args); - fir::ExtendedValue outlineInWrapper(ExtendedGenerator, llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args); - - template - mlir::FuncOp getWrapper(GeneratorType, llvm::StringRef name, - mlir::FunctionType, bool loadRefArguments = false); - - /// Generate calls to ElementalGenerator, handling the elemental aspects - template - fir::ExtendedValue - genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args, bool outline); - - /// Helper to invoke code generator for the intrinsics given arguments. - mlir::Value invokeGenerator(ElementalGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args); - mlir::Value invokeGenerator(RuntimeCallGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args); - mlir::Value invokeGenerator(ExtendedGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args); - - /// Get pointer to unrestricted intrinsic. Generate the related unrestricted - /// intrinsic if it is not defined yet. - mlir::SymbolRefAttr - getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name, - mlir::FunctionType signature); - - fir::FirOpBuilder &builder; - mlir::Location loc; -}; - -/// Table that drives the fir generation depending on the intrinsic. -/// one to one mapping with Fortran arguments. If no mapping is -/// defined here for a generic intrinsic, genRuntimeCall will be called -/// to look for a match in the runtime a emit a call. -struct IntrinsicHandler { - const char *name; - IntrinsicLibrary::Generator generator; - bool isElemental = true; - /// Code heavy intrinsic can be outlined to make FIR - /// more readable. - bool outline = false; -}; -using I = IntrinsicLibrary; -static constexpr IntrinsicHandler handlers[]{ - {"abs", &I::genAbs}, - {"achar", &I::genConversion}, - {"aimag", &I::genAimag}, - {"aint", &I::genAint}, - {"anint", &I::genAnint}, - {"ceiling", &I::genCeiling}, - {"char", &I::genConversion}, - {"conjg", &I::genConjg}, - {"dim", &I::genDim}, - {"dble", &I::genConversion}, - {"dprod", &I::genDprod}, - {"floor", &I::genFloor}, - {"iand", &I::genIAnd}, - {"ichar", &I::genIchar}, - {"ieor", &I::genIEOr}, - {"ior", &I::genIOr}, - {"len", &I::genLen}, - {"len_trim", &I::genLenTrim}, - {"max", &I::genExtremum}, - {"min", &I::genExtremum}, - {"merge", &I::genMerge}, - {"mod", &I::genMod}, - {"nint", &I::genNint}, - {"sign", &I::genSign}, -}; - -/// To make fir output more readable for debug, one can outline all intrinsic -/// implementation in wrappers (overrides the IntrinsicHandler::outline flag). -static llvm::cl::opt outlineAllIntrinsics( - "outline-intrinsics", - llvm::cl::desc( - "Lower all intrinsic procedure implementation in their own functions"), - llvm::cl::init(false)); - -//===----------------------------------------------------------------------===// -// Math runtime description and matching utility -//===----------------------------------------------------------------------===// - -/// Command line option to modify math runtime version used to implement -/// intrinsics. -enum MathRuntimeVersion { - fastVersion, - relaxedVersion, - preciseVersion, - llvmOnly -}; -llvm::cl::opt mathRuntimeVersion( - "math-runtime", llvm::cl::desc("Select math runtime version:"), - llvm::cl::values( - clEnumValN(fastVersion, "fast", "use pgmath fast runtime"), - clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"), - clEnumValN(preciseVersion, "precise", "use pgmath precise runtime"), - clEnumValN(llvmOnly, "llvm", - "only use LLVM intrinsics (may be incomplete)")), - llvm::cl::init(fastVersion)); - -struct RuntimeFunction { - // llvm::StringRef comparison operator are not constexpr, so use string_view. - using Key = std::string_view; - // Needed for implicit compare with keys. - constexpr operator Key() const { return key; } - Key key; // intrinsic name - llvm::StringRef symbol; - Fortran::lower::FuncTypeBuilderFunc typeGenerator; -}; - -#define RUNTIME_STATIC_DESCRIPTION(name, func) \ - {#name, #func, \ - Fortran::lower::RuntimeTableKey::getTypeModel()}, -static constexpr RuntimeFunction pgmathFast[] = { -#define PGMATH_FAST -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "flang/Evaluate/pgmath.h.inc" -}; -static constexpr RuntimeFunction pgmathRelaxed[] = { -#define PGMATH_RELAXED -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "flang/Evaluate/pgmath.h.inc" -}; -static constexpr RuntimeFunction pgmathPrecise[] = { -#define PGMATH_PRECISE -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "flang/Evaluate/pgmath.h.inc" -}; - -static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF32(context); - return mlir::FunctionType::get(context, {t}, {t}); -} - -static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF64(context); - return mlir::FunctionType::get(context, {t}, {t}); -} - -template -static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF64(context); - auto r = mlir::IntegerType::get(context, Bits); - return mlir::FunctionType::get(context, {t}, {r}); -} - -template -static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF32(context); - auto r = mlir::IntegerType::get(context, Bits); - return mlir::FunctionType::get(context, {t}, {r}); -} - -// TODO : Fill-up this table with more intrinsic. -// Note: These are also defined as operations in LLVM dialect. See if this -// can be use and has advantages. -static constexpr RuntimeFunction llvmIntrinsics[] = { - {"abs", "llvm.fabs.f32", genF32F32FuncType}, - {"abs", "llvm.fabs.f64", genF64F64FuncType}, - {"aint", "llvm.trunc.f32", genF32F32FuncType}, - {"aint", "llvm.trunc.f64", genF64F64FuncType}, - {"anint", "llvm.round.f32", genF32F32FuncType}, - {"anint", "llvm.round.f64", genF64F64FuncType}, - // ceil is used for CEILING but is different, it returns a real. - {"ceil", "llvm.ceil.f32", genF32F32FuncType}, - {"ceil", "llvm.ceil.f64", genF64F64FuncType}, - {"cos", "llvm.cos.f32", genF32F32FuncType}, - {"cos", "llvm.cos.f64", genF64F64FuncType}, - // llvm.floor is used for FLOOR, but returns real. - {"floor", "llvm.floor.f32", genF32F32FuncType}, - {"floor", "llvm.floor.f64", genF64F64FuncType}, - {"log", "llvm.log.f32", genF32F32FuncType}, - {"log", "llvm.log.f64", genF64F64FuncType}, - {"log10", "llvm.log10.f32", genF32F32FuncType}, - {"log10", "llvm.log10.f64", genF64F64FuncType}, - {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>}, - {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>}, - {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>}, - {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>}, - {"sin", "llvm.sin.f32", genF32F32FuncType}, - {"sin", "llvm.sin.f64", genF64F64FuncType}, - {"sqrt", "llvm.sqrt.f32", genF32F32FuncType}, - {"sqrt", "llvm.sqrt.f64", genF64F64FuncType}, -}; - -// This helper class computes a "distance" between two function types. -// The distance measures how many narrowing conversions of actual arguments -// and result of "from" must be made in order to use "to" instead of "from". -// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is -// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means -// if no implementation of ACOS(REAL(10)) is available, it is better to use -// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)). -// Note that this is not a symmetric distance and the order of "from" and "to" -// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it -// may be safe to replace foo by bar, but not the opposite. -class FunctionDistance { -public: - FunctionDistance() : infinite{true} {} - - FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) { - auto nInputs = from.getNumInputs(); - auto nResults = from.getNumResults(); - if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) { - infinite = true; - } else { - for (decltype(nInputs) i{0}; i < nInputs && !infinite; ++i) - addArgumentDistance(from.getInput(i), to.getInput(i)); - for (decltype(nResults) i{0}; i < nResults && !infinite; ++i) - addResultDistance(to.getResult(i), from.getResult(i)); - } - } - - /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be - /// false if both d1 and d2 are infinite. This implies that - /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1) - bool isSmallerThan(const FunctionDistance &d) const { - return !infinite && - (d.infinite || std::lexicographical_compare( - conversions.begin(), conversions.end(), - d.conversions.begin(), d.conversions.end())); - } - - bool isLosingPrecision() const { - return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; - } - - bool isInfinite() const { return infinite; } - -private: - enum class Conversion { Forbidden, None, Narrow, Extend }; - - void addArgumentDistance(mlir::Type from, mlir::Type to) { - switch (conversionBetweenTypes(from, to)) { - case Conversion::Forbidden: - infinite = true; - break; - case Conversion::None: - break; - case Conversion::Narrow: - conversions[narrowingArg]++; - break; - case Conversion::Extend: - conversions[nonNarrowingArg]++; - break; - } - } - - void addResultDistance(mlir::Type from, mlir::Type to) { - switch (conversionBetweenTypes(from, to)) { - case Conversion::Forbidden: - infinite = true; - break; - case Conversion::None: - break; - case Conversion::Narrow: - conversions[nonExtendingResult]++; - break; - case Conversion::Extend: - conversions[extendingResult]++; - break; - } - } - - // Floating point can be mlir::FloatType or fir::real - static unsigned getFloatingPointWidth(mlir::Type t) { - if (auto f{t.dyn_cast()}) - return f.getWidth(); - // FIXME: Get width another way for fir.real/complex - // - use fir/KindMapping.h and llvm::Type - // - or use evaluate/type.h - if (auto r{t.dyn_cast()}) - return r.getFKind() * 4; - if (auto cplx{t.dyn_cast()}) - return cplx.getFKind() * 4; - llvm_unreachable("not a floating-point type"); - } - - static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) { - if (from == to) { - return Conversion::None; - } - if (auto fromIntTy{from.dyn_cast()}) { - if (auto toIntTy{to.dyn_cast()}) { - return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow - : Conversion::Extend; - } - } - if (fir::isa_real(from) && fir::isa_real(to)) { - return getFloatingPointWidth(from) > getFloatingPointWidth(to) - ? Conversion::Narrow - : Conversion::Extend; - } - if (auto fromCplxTy{from.dyn_cast()}) { - if (auto toCplxTy{to.dyn_cast()}) { - return getFloatingPointWidth(fromCplxTy) > - getFloatingPointWidth(toCplxTy) - ? Conversion::Narrow - : Conversion::Extend; - } - } - // Notes: - // - No conversion between character types, specialization of runtime - // functions should be made instead. - // - It is not clear there is a use case for automatic conversions - // around Logical and it may damage hidden information in the physical - // storage so do not do it. - return Conversion::Forbidden; - } - - // Below are indexes to access data in conversions. - // The order in data does matter for lexicographical_compare - enum { - narrowingArg = 0, // usually bad - extendingResult, // usually bad - nonExtendingResult, // usually ok - nonNarrowingArg, // usually ok - dataSize - }; - - std::array conversions{/* zero init*/}; - bool infinite{false}; // When forbidden conversion or wrong argument number -}; - -/// Build mlir::FuncOp from runtime symbol description and add -/// fir.runtime attribute. -static mlir::FuncOp getFuncOp(mlir::Location loc, fir::FirOpBuilder &builder, - const RuntimeFunction &runtime) { - auto function = builder.addNamedFunction( - loc, runtime.symbol, runtime.typeGenerator(builder.getContext())); - function->setAttr("fir.runtime", builder.getUnitAttr()); - return function; -} - -/// Select runtime function that has the smallest distance to the intrinsic -/// function type and that will not imply narrowing arguments or extending the -/// result. -/// If nothing is found, the mlir::FuncOp will contain a nullptr. -mlir::FuncOp searchFunctionInLibrary( - mlir::Location loc, fir::FirOpBuilder &builder, - const Fortran::common::StaticMultimapView &lib, - llvm::StringRef name, mlir::FunctionType funcType, - const RuntimeFunction **bestNearMatch, - FunctionDistance &bestMatchDistance) { - auto range = lib.equal_range(name); - for (auto iter{range.first}; iter != range.second && iter; ++iter) { - const auto &impl = *iter; - auto implType = impl.typeGenerator(builder.getContext()); - if (funcType == implType) { - return getFuncOp(loc, builder, impl); // exact match - } else { - FunctionDistance distance(funcType, implType); - if (distance.isSmallerThan(bestMatchDistance)) { - *bestNearMatch = &impl; - bestMatchDistance = std::move(distance); - } - } - } - return {}; -} - -/// Search runtime for the best runtime function given an intrinsic name -/// and interface. The interface may not be a perfect match in which case -/// the caller is responsible to insert argument and return value conversions. -/// If nothing is found, the mlir::FuncOp will contain a nullptr. -static mlir::FuncOp getRuntimeFunction(mlir::Location loc, - fir::FirOpBuilder &builder, - llvm::StringRef name, - mlir::FunctionType funcType) { - const RuntimeFunction *bestNearMatch = nullptr; - FunctionDistance bestMatchDistance{}; - mlir::FuncOp match; - using RtMap = Fortran::common::StaticMultimapView; - static constexpr RtMap pgmathF(pgmathFast); - static_assert(pgmathF.Verify() && "map must be sorted"); - static constexpr RtMap pgmathR(pgmathRelaxed); - static_assert(pgmathR.Verify() && "map must be sorted"); - static constexpr RtMap pgmathP(pgmathPrecise); - static_assert(pgmathP.Verify() && "map must be sorted"); - if (mathRuntimeVersion == fastVersion) { - match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType, - &bestNearMatch, bestMatchDistance); - } else if (mathRuntimeVersion == relaxedVersion) { - match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType, - &bestNearMatch, bestMatchDistance); - } else if (mathRuntimeVersion == preciseVersion) { - match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType, - &bestNearMatch, bestMatchDistance); - } else { - assert(mathRuntimeVersion == llvmOnly && "unknown math runtime"); - } - if (match) - return match; - - // Go through llvm intrinsics if not exact match in libpgmath or if - // mathRuntimeVersion == llvmOnly - static constexpr RtMap llvmIntr(llvmIntrinsics); - static_assert(llvmIntr.Verify() && "map must be sorted"); - if (auto exactMatch = - searchFunctionInLibrary(loc, builder, llvmIntr, name, funcType, - &bestNearMatch, bestMatchDistance)) - return exactMatch; - - if (bestNearMatch != nullptr) { - assert(!bestMatchDistance.isLosingPrecision() && - "runtime selection loses precision"); - return getFuncOp(loc, builder, *bestNearMatch); - } - return {}; -} - -/// Helpers to get function type from arguments and result type. -static mlir::FunctionType getFunctionType(mlir::Type resultType, - llvm::ArrayRef arguments, - fir::FirOpBuilder &builder) { - llvm::SmallVector argumentTypes; - for (auto &arg : arguments) - argumentTypes.push_back(arg.getType()); - return mlir::FunctionType::get(builder.getModule().getContext(), - argumentTypes, resultType); -} - -/// fir::ExtendedValue to mlir::Value translation layer - -fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder, - mlir::Location loc) { - assert(val && "optional unhandled here"); - auto type = val.getType(); - auto base = val; - auto indexType = builder.getIndexType(); - llvm::SmallVector extents; - - Fortran::lower::CharacterExprHelper charHelper{builder, loc}; - if (charHelper.isCharacter(type)) - return charHelper.toExtendedValue(val); - - if (auto refType = type.dyn_cast()) - type = refType.getEleTy(); - - if (auto arrayType = type.dyn_cast()) { - type = arrayType.getEleTy(); - for (auto extent : arrayType.getShape()) { - if (extent == fir::SequenceType::getUnknownExtent()) - break; - extents.emplace_back( - builder.createIntegerConstant(loc, indexType, extent)); - } - // Last extent might be missing in case of assumed-size. If more extents - // could not be deduced from type, that's an error (a fir.box should - // have been used in the interface). - if (extents.size() + 1 < arrayType.getShape().size()) - mlir::emitError(loc, "cannot retrieve array extents from type"); - } else if (type.isa() || type.isa()) { - mlir::emitError(loc, "descriptor or derived type not yet handled"); - } - - if (!extents.empty()) - return fir::ArrayBoxValue{base, extents}; - return base; -} - -mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder, - mlir::Location loc) { - if (auto charBox = val.getCharBox()) { - auto buffer = charBox->getBuffer(); - if (buffer.getType().isa()) - return buffer; - return Fortran::lower::CharacterExprHelper{builder, loc}.createEmboxChar( - buffer, charBox->getLen()); - } - - // FIXME: need to access other ExtendedValue variants and handle them - // properly. - return fir::getBase(val); -} - -//===----------------------------------------------------------------------===// -// IntrinsicLibrary -//===----------------------------------------------------------------------===// - -template -fir::ExtendedValue IntrinsicLibrary::genElementalCall( - GeneratorType generator, llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args, bool outline) { - llvm::SmallVector scalarArgs; - for (const auto &arg : args) { - if (arg.getUnboxed() || arg.getCharBox()) { - scalarArgs.emplace_back(fir::getBase(arg)); - } else { - // TODO: get the result shape and create the loop... - mlir::emitError(loc, "array or descriptor not yet handled in elemental " - "intrinsic lowering"); - exit(1); - } - } - if (outline) - return outlineInWrapper(generator, name, resultType, scalarArgs); - return invokeGenerator(generator, resultType, scalarArgs); -} - -/// Some ExtendedGenerator operating on characters are also elemental -/// (e.g LEN_TRIM). -template <> -fir::ExtendedValue -IntrinsicLibrary::genElementalCall( - ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args, bool outline) { - for (const auto &arg : args) - if (!arg.getUnboxed() && !arg.getCharBox()) { - // TODO: get the result shape and create the loop... - mlir::emitError(loc, "array or descriptor not yet handled in elemental " - "intrinsic lowering"); - exit(1); - } - if (outline) - return outlineInWrapper(generator, name, resultType, args); - return std::invoke(generator, *this, resultType, args); -} - -fir::ExtendedValue -IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - for (auto &handler : handlers) - if (name == handler.name) { - bool outline = handler.outline || outlineAllIntrinsics; - if (const auto *elementalGenerator = - std::get_if(&handler.generator)) - return genElementalCall(*elementalGenerator, name, resultType, args, - outline); - const auto &generator = std::get(handler.generator); - if (handler.isElemental) - return genElementalCall(generator, name, resultType, args, outline); - if (outline) - return outlineInWrapper(generator, name, resultType, args); - return std::invoke(generator, *this, resultType, args); - } - - // Try the runtime if no special handler was defined for the - // intrinsic being called. Maths runtime only has numerical elemental. - // No optional arguments are expected at this point, the code will - // crash if it gets absent optional. - - // FIXME: using toValue to get the type won't work with array arguments. - llvm::SmallVector mlirArgs; - for (const auto &extendedVal : args) { - auto val = toValue(extendedVal, builder, loc); - if (!val) { - // If an absent optional gets there, most likely its handler has just - // not yet been defined. - mlir::emitError(loc, - "TODO: missing intrinsic lowering: " + llvm::Twine(name)); - exit(1); - } - mlirArgs.emplace_back(val); - } - mlir::FunctionType soughtFuncType = - getFunctionType(resultType, mlirArgs, builder); - - auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType); - return genElementalCall(runtimeCallGenerator, name, resultType, args, - /* outline */ true); -} - -mlir::Value -IntrinsicLibrary::invokeGenerator(ElementalGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args) { - return std::invoke(generator, *this, resultType, args); -} - -mlir::Value -IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args) { - return generator(builder, loc, args); -} - -mlir::Value -IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator, - mlir::Type resultType, - llvm::ArrayRef args) { - llvm::SmallVector extendedArgs; - for (auto arg : args) - extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); - auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs); - return toValue(extendedResult, builder, loc); -} - -template -mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, - llvm::StringRef name, - mlir::FunctionType funcType, - bool loadRefArguments) { - assert(funcType.getNumResults() == 1 && - "expect one result for intrinsic functions"); - auto resultType = funcType.getResult(0); - std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType); - auto function = builder.getNamedFunction(wrapperName); - if (!function) { - // First time this wrapper is needed, build it. - function = builder.createFunction(loc, wrapperName, funcType); - function->setAttr("fir.intrinsic", builder.getUnitAttr()); - function.addEntryBlock(); - - // Create local context to emit code into the newly created function - // This new function is not linked to a source file location, only - // its calls will be. - auto localBuilder = - std::make_unique(function, builder.getKindMap()); - localBuilder->setInsertionPointToStart(&function.front()); - // Location of code inside wrapper of the wrapper is independent from - // the location of the intrinsic call. - auto localLoc = localBuilder->getUnknownLoc(); - llvm::SmallVector localArguments; - for (mlir::BlockArgument bArg : function.front().getArguments()) { - auto refType = bArg.getType().dyn_cast(); - if (loadRefArguments && refType) { - auto loaded = localBuilder->create(localLoc, bArg); - localArguments.push_back(loaded); - } else { - localArguments.push_back(bArg); - } - } - - IntrinsicLibrary localLib{*localBuilder, localLoc}; - auto result = - localLib.invokeGenerator(generator, resultType, localArguments); - localBuilder->create(localLoc, result); - } else { - // Wrapper was already built, ensure it has the sought type - assert(function.getType() == funcType && - "conflict between intrinsic wrapper types"); - } - return function; -} - -/// Helpers to detect absent optional (not yet supported in outlining). -bool static hasAbsentOptional(llvm::ArrayRef args) { - for (const auto &arg : args) - if (!arg) - return true; - return false; -} -bool static hasAbsentOptional(llvm::ArrayRef args) { - for (const auto &arg : args) - if (!fir::getBase(arg)) - return true; - return false; -} - -template -mlir::Value -IntrinsicLibrary::outlineInWrapper(GeneratorType generator, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - if (hasAbsentOptional(args)) { - // TODO: absent optional in outlining is an issue: we cannot just ignore - // them. Needs a better interface here. The issue is that we cannot easily - // tell that a value is optional or not here if it is presents. And if it is - // absent, we cannot tell what it type should be. - mlir::emitError(loc, "todo: cannot outline call to intrinsic " + - llvm::Twine(name) + - " with absent optional argument"); - exit(1); - } - - auto funcType = getFunctionType(resultType, args, builder); - auto wrapper = getWrapper(generator, name, funcType); - return builder.create(loc, wrapper, args).getResult(0); -} - -fir::ExtendedValue -IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - if (hasAbsentOptional(args)) { - // TODO - mlir::emitError(loc, "todo: cannot outline call to intrinsic " + - llvm::Twine(name) + - " with absent optional argument"); - exit(1); - } - llvm::SmallVector mlirArgs; - for (const auto &extendedVal : args) - mlirArgs.emplace_back(toValue(extendedVal, builder, loc)); - auto funcType = getFunctionType(resultType, mlirArgs, builder); - auto wrapper = getWrapper(generator, name, funcType); - auto mlirResult = - builder.create(loc, wrapper, mlirArgs).getResult(0); - return toExtendedValue(mlirResult, builder, loc); -} - -IntrinsicLibrary::RuntimeCallGenerator -IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name, - mlir::FunctionType soughtFuncType) { - auto funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType); - if (!funcOp) { - mlir::emitError(loc, - "TODO: missing intrinsic lowering: " + llvm::Twine(name)); - llvm::errs() << "requested type was: " << soughtFuncType << "\n"; - exit(1); - } - - mlir::FunctionType actualFuncType = funcOp.getType(); - assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() && - actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() && - actualFuncType.getNumResults() == 1 && "Bad intrinsic match"); - - return [funcOp, actualFuncType, - soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc, - llvm::ArrayRef args) { - llvm::SmallVector convertedArguments; - for (const auto &pair : llvm::zip(actualFuncType.getInputs(), args)) - convertedArguments.push_back( - builder.createConvert(loc, std::get<0>(pair), std::get<1>(pair))); - auto call = builder.create(loc, funcOp, convertedArguments); - mlir::Type soughtType = soughtFuncType.getResult(0); - return builder.createConvert(loc, soughtType, call.getResult(0)); - }; -} - -mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr( - llvm::StringRef name, mlir::FunctionType signature) { - // Unrestricted intrinsics signature follows implicit rules: argument - // are passed by references. But the runtime versions expect values. - // So instead of duplicating the runtime, just have the wrappers loading - // this before calling the code generators. - bool loadRefArguments = true; - mlir::FuncOp funcOp; - for (auto &handler : handlers) - if (name == handler.name) - funcOp = std::visit( - [&](auto generator) { - return getWrapper(generator, name, signature, loadRefArguments); - }, - handler.generator); - - if (!funcOp) { - llvm::SmallVector argTypes; - for (auto type : signature.getInputs()) { - if (auto refType = type.dyn_cast()) - argTypes.push_back(refType.getEleTy()); - else - argTypes.push_back(type); - } - auto soughtFuncType = - builder.getFunctionType(signature.getResults(), argTypes); - auto rtCallGenerator = getRuntimeCallGenerator(name, soughtFuncType); - funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments); - } - - return SymbolRefAttr::get(funcOp); -} - -//===----------------------------------------------------------------------===// -// Code generators for the intrinsic -//===----------------------------------------------------------------------===// - -mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args) { - mlir::FunctionType soughtFuncType = - getFunctionType(resultType, args, builder); - return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args); -} - -mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, - llvm::ArrayRef args) { - // There can be an optional kind in second argument. - assert(args.size() >= 1); - return builder.convertWithSemantics(loc, resultType, args[0]); -} - -// ABS -mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - auto arg = args[0]; - auto type = arg.getType(); - if (fir::isa_real(type)) { - // Runtime call to fp abs. An alternative would be to use mlir math::AbsOp - // but it does not support all fir floating point types. - return genRuntimeCall("abs", resultType, args); - } - if (auto intType = type.dyn_cast()) { - // At the time of this implementation there is no abs op in mlir. - // So, implement abs here without branching. - auto shift = - builder.createIntegerConstant(loc, intType, intType.getWidth() - 1); - auto mask = builder.create(loc, arg, shift); - auto xored = builder.create(loc, arg, mask); - return builder.create(loc, xored, mask); - } - if (fir::isa_complex(type)) { - // Use HYPOT to fulfill the no underflow/overflow requirement. - auto parts = fir::factory::Complex{builder, loc}.extractParts(arg); - llvm::SmallVector args = {parts.first, parts.second}; - return genRuntimeCall("hypot", resultType, args); - } - llvm_unreachable("unexpected type in ABS argument"); -} - -// AIMAG -mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - return fir::factory::Complex{builder, loc}.extractComplexPart( - args[0], true /* isImagPart */); -} - -// ANINT -mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() >= 1); - // Skip optional kind argument to search the runtime; it is already reflected - // in result type. - return genRuntimeCall("anint", resultType, {args[0]}); -} - -// AINT -mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() >= 1); - // Skip optional kind argument to search the runtime; it is already reflected - // in result type. - return genRuntimeCall("aint", resultType, {args[0]}); -} - -// CEILING -mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument. - assert(args.size() >= 1); - auto arg = args[0]; - // Use ceil that is not an actual Fortran intrinsic but that is - // an llvm intrinsic that does the same, but return a floating - // point. - auto ceil = genRuntimeCall("ceil", arg.getType(), {arg}); - return builder.createConvert(loc, resultType, ceil); -} - -// CONJG -mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - if (resultType != args[0].getType()) - llvm_unreachable("argument type mismatch"); - - mlir::Value cplx = args[0]; - auto imag = fir::factory::Complex{builder, loc}.extractComplexPart( - cplx, /*isImagPart=*/true); - auto negImag = builder.create(loc, imag); - return fir::factory::Complex{builder, loc}.insertComplexPart( - cplx, negImag, /*isImagPart=*/true); -} - -// DIM -mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - if (resultType.isa()) { - auto zero = builder.createIntegerConstant(loc, resultType, 0); - auto diff = builder.create(loc, args[0], args[1]); - auto cmp = builder.create( - loc, mlir::arith::CmpIPredicate::sgt, diff, zero); - return builder.create(loc, cmp, diff, zero); - } - assert(fir::isa_real(resultType) && "Only expects real and integer in DIM"); - auto zero = builder.createRealZeroConstant(loc, resultType); - auto diff = builder.create(loc, args[0], args[1]); - auto cmp = builder.create( - loc, mlir::arith::CmpFPredicate::OGT, diff, zero); - return builder.create(loc, cmp, diff, zero); -} - -// DPROD -mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - assert(fir::isa_real(resultType) && - "Result must be double precision in DPROD"); - auto a = builder.createConvert(loc, resultType, args[0]); - auto b = builder.createConvert(loc, resultType, args[1]); - return builder.create(loc, a, b); -} - -// FLOOR -mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument. - assert(args.size() >= 1); - auto arg = args[0]; - // Use LLVM floor that returns real. - auto floor = genRuntimeCall("floor", arg.getType(), {arg}); - return builder.createConvert(loc, resultType, floor); -} - -// IAND -mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.create(loc, args[0], args[1]); -} - -// ICHAR -mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, - llvm::ArrayRef args) { - // There can be an optional kind in second argument. - assert(args.size() >= 1); - - auto arg = args[0]; - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto dataAndLen = helper.createUnboxChar(arg); - auto charType = fir::CharacterType::get( - builder.getContext(), helper.getCharacterKind(arg.getType()), 1); - auto refType = builder.getRefType(charType); - auto charAddr = builder.createConvert(loc, refType, dataAndLen.first); - auto charVal = builder.create(loc, charType, charAddr); - return builder.createConvert(loc, resultType, charVal); -} - -// IEOR -mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - return builder.create(loc, args[0], args[1]); -} - -// IOR -mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - return builder.create(loc, args[0], args[1]); -} - -// LEN -// Note that this is only used for unrestricted intrinsic. -// Usage of LEN are otherwise rewritten as descriptor inquiries by the -// front-end. -fir::ExtendedValue -IntrinsicLibrary::genLen(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument reflected in result type. - assert(args.size() >= 1); - mlir::Value len; - if (const auto *charBox = args[0].getCharBox()) { - len = charBox->getLen(); - } else if (const auto *charBoxArray = args[0].getCharBox()) { - len = charBoxArray->getLen(); - } else { - Fortran::lower::CharacterExprHelper helper{builder, loc}; - len = helper.createUnboxChar(fir::getBase(args[0])).second; - } - - return builder.createConvert(loc, resultType, len); -} - -// LEN_TRIM -fir::ExtendedValue -IntrinsicLibrary::genLenTrim(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument reflected in result type. - assert(args.size() >= 1); - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto len = helper.createLenTrim(fir::getBase(args[0])); - return builder.createConvert(loc, resultType, len); -} - -// MERGE -mlir::Value IntrinsicLibrary::genMerge(mlir::Type, - llvm::ArrayRef args) { - assert(args.size() == 3); - - auto i1Type = mlir::IntegerType::get(builder.getContext(), 1); - auto mask = builder.createConvert(loc, i1Type, args[2]); - return builder.create(loc, mask, args[0], args[1]); -} - -// MOD -mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - if (resultType.isa()) - return builder.create(loc, args[0], args[1]); - - // Use runtime. Note that mlir::arith::RemFOp implements floating point - // remainder, but it does not work with fir::Real type. - // TODO: consider using mlir::arith::RemFOp when possible, that may help - // folding and optimizations. - return genRuntimeCall("mod", resultType, args); -} - -// NINT -mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() >= 1); - // Skip optional kind argument to search the runtime; it is already reflected - // in result type. - return genRuntimeCall("nint", resultType, {args[0]}); -} - -// SIGN -mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - auto abs = genAbs(resultType, {args[0]}); - if (resultType.isa()) { - auto zero = builder.createIntegerConstant(loc, resultType, 0); - auto neg = builder.create(loc, zero, abs); - auto cmp = builder.create( - loc, mlir::arith::CmpIPredicate::slt, args[1], zero); - return builder.create(loc, cmp, neg, abs); - } - // TODO: Requirements when second argument is +0./0. - auto zeroAttr = builder.getZeroAttr(resultType); - auto zero = - builder.create(loc, resultType, zeroAttr); - auto neg = builder.create(loc, abs); - auto cmp = builder.create( - loc, mlir::arith::CmpFPredicate::OLT, args[1], zero); - return builder.create(loc, cmp, neg, abs); -} - -// Compare two FIR values and return boolean result as i1. -template -static mlir::Value createExtremumCompare(mlir::Location loc, - fir::FirOpBuilder &builder, - mlir::Value left, mlir::Value right) { - static constexpr auto integerPredicate = - extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt - : mlir::arith::CmpIPredicate::slt; - static constexpr auto orderedCmp = extremum == Extremum::Max - ? mlir::arith::CmpFPredicate::OGT - : mlir::arith::CmpFPredicate::OLT; - auto type = left.getType(); - mlir::Value result; - if (fir::isa_real(type)) { - // Note: the signaling/quit aspect of the result required by IEEE - // cannot currently be obtained with LLVM without ad-hoc runtime. - if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) { - // Return the number if one of the inputs is NaN and the other is - // a number. - auto leftIsResult = - builder.create(loc, orderedCmp, left, right); - auto rightIsNan = builder.create( - loc, mlir::arith::CmpFPredicate::UNE, right, right); - result = - builder.create(loc, leftIsResult, rightIsNan); - } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { - // Always return NaNs if one the input is NaNs - auto leftIsResult = - builder.create(loc, orderedCmp, left, right); - auto leftIsNan = builder.create( - loc, mlir::arith::CmpFPredicate::UNE, left, left); - result = builder.create(loc, leftIsResult, leftIsNan); - } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { - // If the left is a NaN, return the right whatever it is. - result = - builder.create(loc, orderedCmp, left, right); - } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { - // If one of the operand is a NaN, return left whatever it is. - static constexpr auto unorderedCmp = - extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT - : mlir::arith::CmpFPredicate::ULT; - result = - builder.create(loc, unorderedCmp, left, right); - } else { - // TODO: ieeeMinNum/ieeeMaxNum - static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, - "ieeeMinNum/ieeeMaxNum behavior not implemented"); - } - } else if (fir::isa_integer(type)) { - result = - builder.create(loc, integerPredicate, left, right); - } else if (type.isa()) { - // TODO: ! character min and max is tricky because the result - // length is the length of the longest argument! - // So we may need a temp. - } - assert(result); - return result; -} - -// MIN and MAX -template -mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, - llvm::ArrayRef args) { - assert(args.size() >= 1); - mlir::Value result = args[0]; - for (auto arg : args.drop_front()) { - auto mask = - createExtremumCompare(loc, builder, result, arg); - result = builder.create(loc, mask, result, arg); - } - return result; -} - -//===----------------------------------------------------------------------===// -// Public intrinsic call helpers -//===----------------------------------------------------------------------===// - -fir::ExtendedValue -Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType, - args); -} - -mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder, - mlir::Location loc, - llvm::ArrayRef args) { - assert(args.size() > 0 && "max requires at least one argument"); - return IntrinsicLibrary{builder, loc} - .genExtremum(args[0].getType(), - args); -} - -mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder, - mlir::Location loc, - llvm::ArrayRef args) { - assert(args.size() > 0 && "min requires at least one argument"); - return IntrinsicLibrary{builder, loc} - .genExtremum(args[0].getType(), - args); -} - -mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder, - mlir::Location loc, mlir::Type type, - mlir::Value x, mlir::Value y) { - return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y}); -} - -mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr( - fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name, - mlir::FunctionType signature) { - return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr( - name, signature); -}