diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/IntrinsicCall.h @@ -0,0 +1,83 @@ +//===-- 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" +#include "llvm/ADT/Optional.h" + +namespace fir { +class ExtendedValue; +} + +namespace Fortran::lower { + +// TODO: Error handling interface ? +// TODO: Implementation is incomplete. Many intrinsics to tbd. + +/// 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, + llvm::Optional resultType, + llvm::ArrayRef args); + +/// Enum specifying how intrinsic argument evaluate::Expr should be +/// lowered to fir::ExtendedValue to be passed to genIntrinsicCall. +enum class LowerIntrinsicArgAs { + /// Lower argument to a value. Mainly intended for scalar arguments. + Value, + /// Lower argument to an address. Only valid when the argument properties are + /// fully defined (e.g. allocatable is allocated...). + Addr, + /// Lower argument to a box. + Box, + /// Lower argument without assuming that the argument is fully defined. + /// It can be used on unallocated allocatable, disassociated pointer, + /// or absent optional. This is meant for inquiry intrinsic arguments. + Inquired +}; + +/// Define how a given intrinsic argument must be lowered. +struct ArgLoweringRule { + LowerIntrinsicArgAs lowerAs; + /// Value: + // - Numerical: 0 + // - Logical : false + // - Derived/character: not possible. Need custom intrinsic lowering. + // Addr: + // - nullptr + // Box: + // - absent box + // AsInquired: + // - no-op + bool handleDynamicOptional; +}; + +/// Opaque class defining the argument lowering rules for all the argument of +/// an intrinsic. +struct IntrinsicArgumentLoweringRules; + +/// Return argument lowering rules for an intrinsic. +/// Returns a nullptr if all the intrinsic arguments should be lowered by value. +const IntrinsicArgumentLoweringRules * +getIntrinsicArgumentLowering(llvm::StringRef intrinsicName); + +/// Return how argument \p argName should be lowered given the rules for the +/// intrinsic function. The argument names are the one defined by the standard. +ArgLoweringRule lowerIntrinsicArgumentAs(mlir::Location, + const IntrinsicArgumentLoweringRules &, + llvm::StringRef argName); + +/// Return place-holder for absent intrinsic arguments. +fir::ExtendedValue getAbsentIntrinsicArgument(); +} // 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 @@ -7,6 +7,7 @@ ConvertExpr.cpp ConvertType.cpp ConvertVariable.cpp + IntrinsicCall.cpp Mangler.cpp OpenACC.cpp OpenMP.cpp diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -15,6 +15,7 @@ #include "flang/Evaluate/real.h" #include "flang/Evaluate/traverse.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" #include "flang/Semantics/expression.h" @@ -90,6 +91,16 @@ }); } +/// Is this a call to an elemental procedure with at least one array argument? +static bool +isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) { + if (procRef.IsElemental()) + for (const std::optional &arg : + procRef.arguments()) + if (arg && arg->Rank() != 0) + return true; + return false; +} namespace { /// Lowering of Fortran::evaluate::Expr expressions @@ -426,6 +437,23 @@ return std::visit([&](const auto &x) { return genval(x); }, des.u); } + mlir::Type genType(const Fortran::evaluate::DynamicType &dt) { + if (dt.category() != Fortran::common::TypeCategory::Derived) + return converter.genType(dt.category(), dt.kind()); + TODO(getLoc(), "genType Derived Type"); + } + + /// Lower a function reference + template + ExtValue genFunctionRef(const Fortran::evaluate::FunctionRef &funcRef) { + if (!funcRef.GetType().has_value()) + fir::emitFatalError(getLoc(), "internal: a function must have a type"); + mlir::Type resTy = genType(*funcRef.GetType()); + return genProcedureRef(funcRef, {resTy}); + } + + /// Lower function call `funcRef` and return a reference to the resultant + /// value. This is required for lowering expressions such as `f1(f2(v))`. template ExtValue gen(const Fortran::evaluate::FunctionRef &funcRef) { TODO(getLoc(), "gen FunctionRef"); @@ -433,13 +461,67 @@ template ExtValue genval(const Fortran::evaluate::FunctionRef &funcRef) { - TODO(getLoc(), "genval FunctionRef"); + ExtValue result = genFunctionRef(funcRef); + if (result.rank() == 0 && fir::isa_ref_type(fir::getBase(result).getType())) + return genLoad(result); + return result; } ExtValue genval(const Fortran::evaluate::ProcedureRef &procRef) { TODO(getLoc(), "genval ProcedureRef"); } + /// Generate a call to an intrinsic function. + ExtValue + genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, + const Fortran::evaluate::SpecificIntrinsic &intrinsic, + llvm::Optional resultType) { + llvm::SmallVector operands; + + llvm::StringRef name = intrinsic.name; + mlir::Location loc = getLoc(); + + const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering = + Fortran::lower::getIntrinsicArgumentLowering(name); + for (const auto &[arg, dummy] : + llvm::zip(procRef.arguments(), + intrinsic.characteristics.value().dummyArguments)) { + auto *expr = Fortran::evaluate::UnwrapExpr(arg); + if (!expr) { + // Absent optional. + operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument()); + continue; + } + if (!argLowering) { + // No argument lowering instruction, lower by value. + operands.emplace_back(genval(*expr)); + continue; + } + // Ad-hoc argument lowering handling. + Fortran::lower::ArgLoweringRule argRules = + Fortran::lower::lowerIntrinsicArgumentAs(loc, *argLowering, + dummy.name); + switch (argRules.lowerAs) { + case Fortran::lower::LowerIntrinsicArgAs::Value: + operands.emplace_back(genval(*expr)); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Addr: + TODO(getLoc(), "argument lowering for Addr"); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Box: + TODO(getLoc(), "argument lowering for Box"); + continue; + case Fortran::lower::LowerIntrinsicArgAs::Inquired: + TODO(getLoc(), "argument lowering for Inquired"); + continue; + } + llvm_unreachable("bad switch"); + } + // Let the intrinsic library lower the intrinsic procedure call + return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, resultType, + operands); + } + template ExtValue genval(const Fortran::evaluate::Expr &x) { if (isScalar(x)) @@ -447,6 +529,28 @@ TODO(getLoc(), "genval Expr arrays"); } + /// Lower a non-elemental procedure reference. + // TODO: Handle read allocatable and pointer results. + ExtValue genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef, + llvm::Optional resultType) { + ExtValue res = genRawProcedureRef(procRef, resultType); + return res; + } + + /// Lower a non-elemental procedure reference. + ExtValue genRawProcedureRef(const Fortran::evaluate::ProcedureRef &procRef, + llvm::Optional resultType) { + mlir::Location loc = getLoc(); + if (isElementalProcWithArrayArgs(procRef)) + fir::emitFatalError(loc, "trying to lower elemental procedure with array " + "arguments as normal procedure"); + if (const Fortran::evaluate::SpecificIntrinsic *intrinsic = + procRef.proc().GetSpecificIntrinsic()) + return genIntrinsicRef(procRef, *intrinsic, resultType); + + return {}; + } + /// Helper to detect Transformational function reference. template bool isTransformationalRef(const T &) { diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -0,0 +1,220 @@ +//===-- 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 "flang/Lower/SymbolMap.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Support/FatalError.h" + +#define DEBUG_TYPE "flang-lower-intrinsic" + +/// 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. + +fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() { + return fir::UnboxedValue{}; +} + +// 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, + llvm::Optional resultType, + llvm::ArrayRef arg); + + mlir::Value genIand(mlir::Type, llvm::ArrayRef); + + /// Define the different FIR generators that can be mapped to intrinsic to + /// generate the related code. + using ElementalGenerator = decltype(&IntrinsicLibrary::genIand); + using Generator = std::variant; + + /// 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); + fir::FirOpBuilder &builder; + mlir::Location loc; +}; + +struct IntrinsicDummyArgument { + const char *name = nullptr; + Fortran::lower::LowerIntrinsicArgAs lowerAs = + Fortran::lower::LowerIntrinsicArgAs::Value; + bool handleDynamicOptional = false; +}; + +struct Fortran::lower::IntrinsicArgumentLoweringRules { + /// There is no more than 7 non repeated arguments in Fortran intrinsics. + IntrinsicDummyArgument args[7]; + constexpr bool hasDefaultRules() const { return args[0].name == nullptr; } +}; + +/// Structure describing what needs to be done to lower intrinsic "name". +struct IntrinsicHandler { + const char *name; + IntrinsicLibrary::Generator generator; + Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {}; +}; + +using I = IntrinsicLibrary; + +/// 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. Note that the argument +/// lowering rules for an intrinsic need to be provided only if at least one +/// argument must not be lowered by value. In which case, the lowering rules +/// should be provided for all the intrinsic arguments for completeness. +static constexpr IntrinsicHandler handlers[]{ + {"iand", &I::genIand}, +}; + +static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) { + auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) { + return name.compare(handler.name) > 0; + }; + auto result = + std::lower_bound(std::begin(handlers), std::end(handlers), name, compare); + return result != std::end(handlers) && result->name == name ? result + : nullptr; +} + +//===----------------------------------------------------------------------===// +// IntrinsicLibrary +//===----------------------------------------------------------------------===// + +template +fir::ExtendedValue IntrinsicLibrary::genElementalCall( + GeneratorType generator, llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args, bool outline) { + llvm::SmallVector scalarArgs; + for (const fir::ExtendedValue &arg : args) + if (arg.getUnboxed() || arg.getCharBox()) + scalarArgs.emplace_back(fir::getBase(arg)); + else + fir::emitFatalError(loc, "nonscalar intrinsic argument"); + return invokeGenerator(generator, resultType, scalarArgs); +} + +static fir::ExtendedValue +invokeHandler(IntrinsicLibrary::ElementalGenerator generator, + const IntrinsicHandler &handler, + llvm::Optional resultType, + llvm::ArrayRef args, bool outline, + IntrinsicLibrary &lib) { + assert(resultType && "expect elemental intrinsic to be functions"); + return lib.genElementalCall(generator, handler.name, *resultType, args, + outline); +} + +fir::ExtendedValue +IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, + llvm::Optional resultType, + llvm::ArrayRef args) { + if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) { + bool outline = false; + return std::visit( + [&](auto &generator) -> fir::ExtendedValue { + return invokeHandler(generator, *handler, resultType, args, outline, + *this); + }, + handler->generator); + } + + TODO(loc, "genIntrinsicCall runtime"); + return {}; +} + +mlir::Value +IntrinsicLibrary::invokeGenerator(ElementalGenerator generator, + mlir::Type resultType, + llvm::ArrayRef args) { + return std::invoke(generator, *this, resultType, args); +} +//===----------------------------------------------------------------------===// +// Code generators for the intrinsic +//===----------------------------------------------------------------------===// + +// IAND +mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + return builder.create(loc, args[0], args[1]); +} + +//===----------------------------------------------------------------------===// +// Argument lowering rules interface +//===----------------------------------------------------------------------===// + +const Fortran::lower::IntrinsicArgumentLoweringRules * +Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) { + if (const auto &handler = findIntrinsicHandler(intrinsicName)) + if (!handler->argLoweringRules.hasDefaultRules()) + return &handler->argLoweringRules; + return nullptr; +} + +/// Return how argument \p argName should be lowered given the rules for the +/// intrinsic function. +Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs( + mlir::Location loc, const IntrinsicArgumentLoweringRules &rules, + llvm::StringRef argName) { + for (const auto &arg : rules.args) { + if (arg.name && arg.name == argName) + return {arg.lowerAs, arg.handleDynamicOptional}; + } + fir::emitFatalError( + loc, "internal: unknown intrinsic argument name in lowering '" + argName + + "'"); +} + +//===----------------------------------------------------------------------===// +// Public intrinsic call helpers +//===----------------------------------------------------------------------===// + +fir::ExtendedValue +Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc, + llvm::StringRef name, + llvm::Optional resultType, + llvm::ArrayRef args) { + return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType, + args); +} diff --git a/flang/test/Lower/Intrinsics/iand.f90 b/flang/test/Lower/Intrinsics/iand.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/iand.f90 @@ -0,0 +1,79 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: iand_test +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test(a, b, c) + integer :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i32 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test + +! CHECK-LABEL: iand_test1 +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test1(a, b, c) + integer(kind=1) :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i8 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test1 + +! CHECK-LABEL: iand_test2 +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test2(a, b, c) + integer(kind=2) :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i16 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test2 + +! CHECK-LABEL: iand_test3 +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test3(a, b, c) + integer(kind=4) :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i32 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test3 + +! CHECK-LABEL: iand_test4 +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test4(a, b, c) + integer(kind=8) :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i64 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test4 + +! CHECK-LABEL: iand_test5 +! CHECK-SAME: %[[A:.*]]: !fir.ref{{.*}}, %[[B:.*]]: !fir.ref{{.*}}, %[[C:.*]]: !fir.ref{{.*}} +subroutine iand_test5(a, b, c) + integer(kind=16) :: a, b, c +! CHECK: %[[A_VAL:.*]] = fir.load %[[A]] : !fir.ref +! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref + c = iand(a, b) +! CHECK: %[[C_VAL:.*]] = arith.andi %[[A_VAL]], %[[B_VAL]] : i128 +! CHECK: fir.store %[[C_VAL]] to %[[C]] : !fir.ref +end subroutine iand_test5 + +! CHECK-LABEL: iand_test6 +! CHECK-SAME: %[[S1:.*]]: !fir.ref{{.*}}, %[[S2:.*]]: !fir.ref{{.*}} +subroutine iand_test6(s1, s2) + integer :: s1, s2 +! CHECK-DAG: %[[S1_VAL:.*]] = fir.load %[[S1]] : !fir.ref +! CHECK-DAG: %[[S2_VAL:.*]] = fir.load %[[S2]] : !fir.ref + stop iand(s1,s2) +! CHECK-DAG: %[[ANDI:.*]] = arith.andi %[[S1_VAL]], %[[S2_VAL]] : i32 +! CHECK: fir.call @_FortranAStopStatement(%[[ANDI]], {{.*}}, {{.*}}) : (i32, i1, i1) -> none +! CHECK-NEXT: fir.unreachable +end subroutine iand_test6