diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -5,12 +5,23 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_ABSTRACTCONVERTER_H #define FORTRAN_LOWER_ABSTRACTCONVERTER_H #include "flang/Common/Fortran.h" +#include "flang/Optimizer/Builder/BoxValue.h" #include "mlir/IR/BuiltinOps.h" +#include "llvm/ADT/ArrayRef.h" + +namespace fir { +class KindMapping; +class FirOpBuilder; +} // namespace fir namespace fir { class KindMapping; @@ -22,6 +33,7 @@ template class Reference; } + namespace evaluate { struct DataRef; template @@ -35,7 +47,8 @@ } namespace semantics { class Symbol; -} +class DerivedTypeSpec; +} // namespace semantics namespace lower { namespace pft { @@ -109,7 +122,7 @@ /// Get the converter's current location virtual mlir::Location getCurrentLocation() = 0; /// Generate a dummy location - virtual mlir::Location genLocation() = 0; + virtual mlir::Location genUnknownLocation() = 0; /// Generate the location as converted from a CharBlock virtual mlir::Location genLocation(const Fortran::parser::CharBlock &) = 0; @@ -125,10 +138,8 @@ virtual mlir::MLIRContext &getMLIRContext() = 0; /// Unique a symbol virtual std::string mangleName(const Fortran::semantics::Symbol &) = 0; - /// Unique a compiler generated identifier. A short prefix should be provided - /// to hint at the origin of the identifier. - virtual std::string uniqueCGIdent(llvm::StringRef prefix, - llvm::StringRef name) = 0; + /// Get the KindMap. + virtual const fir::KindMapping &getKindMap() = 0; virtual ~AbstractConverter() = default; }; diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -50,17 +50,20 @@ public: /// Create a lowering bridge instance. static LoweringBridge - create(const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + create(mlir::MLIRContext &ctx, + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSources &allCooked) { - return LoweringBridge{defaultKinds, intrinsics, allCooked}; + const Fortran::parser::AllCookedSources &allCooked, + llvm::StringRef triple, fir::KindMapping &kindMap) { + return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple, + kindMap); } //===--------------------------------------------------------------------===// // Getters //===--------------------------------------------------------------------===// - mlir::MLIRContext &getMLIRContext() { return *context.get(); } + mlir::MLIRContext &getMLIRContext() { return context; } mlir::ModuleOp &getModule() { return *module.get(); } const Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() const { return defaultKinds; @@ -94,18 +97,20 @@ private: explicit LoweringBridge( + mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSources &); + const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, + fir::KindMapping &kindMap); LoweringBridge() = delete; LoweringBridge(const LoweringBridge &) = delete; const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds; const Fortran::evaluate::IntrinsicProcTable &intrinsics; const Fortran::parser::AllCookedSources *cooked; - std::unique_ptr context; + mlir::MLIRContext &context; std::unique_ptr module; - fir::KindMapping kindMap; + fir::KindMapping &kindMap; }; } // namespace lower diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/CallInterface.h @@ -0,0 +1,178 @@ +//===-- Lower/CallInterface.h -- Procedure call interface ------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +// +// Utility that defines fir call interface for procedure both on caller and +// and callee side and get the related FuncOp. +// It does not emit any FIR code but for the created mlir::FuncOp, instead it +// provides back a container of Symbol (callee side)/ActualArgument (caller +// side) with additional information for each element describing how it must be +// plugged with the mlir::FuncOp. +// It handles the fact that hidden arguments may be inserted for the result. +// while lowering. +// +// This utility uses the characteristic of Fortran procedures to operate, which +// is a term and concept used in Fortran to refer to the signature of a function +// or subroutine. +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CALLINTERFACE_H +#define FORTRAN_LOWER_CALLINTERFACE_H + +#include "flang/Common/reference.h" +#include "flang/Evaluate/characteristics.h" +#include "mlir/IR/BuiltinOps.h" +#include +#include + +namespace Fortran::semantics { +class Symbol; +} + +namespace mlir { +class Location; +} + +namespace Fortran::lower { +class AbstractConverter; +namespace pft { +struct FunctionLikeUnit; +} + +/// PassedEntityTypes helps abstract whether CallInterface is mapping a +/// Symbol to mlir::Value (callee side) or an ActualArgument to a position +/// inside the input vector for the CallOp (caller side. It will be up to the +/// CallInterface user to produce the mlir::Value that will go in this input +/// vector). +class CalleeInterface; +template +struct PassedEntityTypes {}; +template <> +struct PassedEntityTypes { + using FortranEntity = + std::optional>; + using FirValue = mlir::Value; +}; + +/// Implementation helper +template +class CallInterfaceImpl; + +/// CallInterface defines all the logic to determine FIR function interfaces +/// from a characteristic, build the mlir::FuncOp and describe back the argument +/// mapping to its user. +/// The logic is shared between the callee and caller sides that it accepts as +/// a curiously recursive template to handle the few things that cannot be +/// shared between both sides (getting characteristics, mangled name, location). +/// It maps FIR arguments to front-end Symbol (callee side) or ActualArgument +/// (caller side) with the same code using the abstract FortranEntity type that +/// can be either a Symbol or an ActualArgument. +/// It works in two passes: a first pass over the characteristics that decides +/// how the interface must be. Then, the funcOp is created for it. Then a simple +/// pass over fir arguments finalizes the interface information that must be +/// passed back to the user (and may require having the funcOp). All these +/// passes are driven from the CallInterface constructor. +template +class CallInterface { + friend CallInterfaceImpl; + +public: + /// Different properties of an entity that can be passed/returned. + /// One-to-One mapping with PassEntityBy but for + /// PassEntityBy::AddressAndLength that has two properties. + enum class Property { + BaseAddress, + BoxChar, + CharAddress, + CharLength, + CharProcTuple, + Box, + MutableBox, + Value + }; + + using FortranEntity = typename PassedEntityTypes::FortranEntity; + using FirValue = typename PassedEntityTypes::FirValue; + + /// FirPlaceHolder are place holders for the mlir inputs and outputs that are + /// created during the first pass before the mlir::FuncOp is created. + struct FirPlaceHolder { + FirPlaceHolder(mlir::Type t, int passedPosition, Property p, + llvm::ArrayRef attrs) + : type{t}, passedEntityPosition{passedPosition}, property{p}, + attributes{attrs.begin(), attrs.end()} {} + /// Type for this input/output + mlir::Type type; + /// Position of related passedEntity in passedArguments. + /// (passedEntity is the passedResult this value is resultEntityPosition). + int passedEntityPosition; + /// Indicate property of the entity passedEntityPosition that must be passed + /// through this argument. + Property property; + /// MLIR attributes for this argument + llvm::SmallVector attributes; + }; + + /// Returns the mlir function type + mlir::FunctionType genFunctionType(); + +protected: + CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {} + /// CRTP handle. + T &side() { return *static_cast(this); } + /// Entry point to be called by child ctor to analyze the signature and + /// create/find the mlir::FuncOp. Child needs to be initialized first. + void declare(); + + llvm::SmallVector outputs; + llvm::SmallVector inputs; + mlir::FuncOp func; + + Fortran::lower::AbstractConverter &converter; +}; + +//===----------------------------------------------------------------------===// +// Callee side interface +//===----------------------------------------------------------------------===// + +/// CalleeInterface only provides the helpers needed by CallInterface +/// to abstract the specificities of the callee side. +class CalleeInterface : public CallInterface { +public: + CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f, + Fortran::lower::AbstractConverter &c) + : CallInterface{c}, funit{f} { + declare(); + } + + std::string getMangledName() const; + mlir::Location getCalleeLocation() const; + Fortran::evaluate::characteristics::Procedure characterize() const; + + /// On the callee side it does not matter whether the procedure is + /// called through pointers or not. + bool isIndirectCall() const { return false; } + + /// Return the procedure symbol if this is a call to a user defined + /// procedure. + const Fortran::semantics::Symbol *getProcedureSymbol() const; + + /// Add mlir::FuncOp entry block and map fir block arguments to Fortran dummy + /// argument symbols. + mlir::FuncOp addEntryBlockAndMapArguments(); + +private: + Fortran::lower::pft::FunctionLikeUnit &funit; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_FIRBUILDER_H diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -354,6 +354,13 @@ PftNode parent; }; +/// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end +/// statements. +template +static parser::CharBlock stmtSourceLoc(const T &stmt) { + return stmt.visit(common::visitors{[](const auto &x) { return x.source; }}); +} + /// A variable captures an object to be created per the declaration part of a /// function like unit. /// diff --git a/flang/include/flang/Lower/Support/Verifier.h b/flang/include/flang/Lower/Support/Verifier.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/Support/Verifier.h @@ -0,0 +1,34 @@ +//===-- Lower/Support/Verifier.h -- verify pass for lowering ----*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_SUPPORT_VERIFIER_H +#define FORTRAN_LOWER_SUPPORT_VERIFIER_H + +#include "mlir/IR/Verifier.h" +#include "mlir/Pass/Pass.h" + +namespace Fortran::lower { + +/// A verification pass to verify the output from the bridge. This provides a +/// little bit of glue to run a verifier pass directly. +class VerifierPass + : public mlir::PassWrapper> { + void runOnOperation() override final { + if (mlir::failed(mlir::verify(getOperation()))) + signalPassFailure(); + markAllAnalysesPreserved(); + } +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_SUPPORT_VERIFIER_H diff --git a/flang/include/flang/Lower/SymbolMap.h b/flang/include/flang/Lower/SymbolMap.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/SymbolMap.h @@ -0,0 +1,347 @@ +//===-- SymbolMap.h -- lowering internal symbol map -------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_SYMBOLMAP_H +#define FORTRAN_LOWER_SYMBOLMAP_H + +#include "flang/Common/reference.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/Matcher.h" +#include "flang/Semantics/symbol.h" +#include "mlir/IR/Value.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/Optional.h" +#include "llvm/ADT/SmallVector.h" +#include "llvm/Support/Compiler.h" + +namespace Fortran::lower { + +struct SymbolBox; +class SymMap; +llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const SymbolBox &symMap); +llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const SymMap &symMap); + +//===----------------------------------------------------------------------===// +// Symbol information +//===----------------------------------------------------------------------===// + +/// A dictionary entry of ssa-values that together compose a variable referenced +/// by a Symbol. For example, the declaration +/// +/// CHARACTER(LEN=i) :: c(j1,j2) +/// +/// is a single variable `c`. This variable is a two-dimensional array of +/// CHARACTER. It has a starting address and three dynamic properties: the LEN +/// parameter `i` a runtime value describing the length of the CHARACTER, and +/// the `j1` and `j2` runtime values, which describe the shape of the array. +/// +/// The lowering bridge needs to be able to record all four of these ssa-values +/// in the lookup table to be able to correctly lower Fortran to FIR. +struct SymbolBox : public fir::details::matcher { + // For lookups that fail, have a monostate + using None = std::monostate; + + // Trivial intrinsic type + using Intrinsic = fir::AbstractBox; + + // Array variable that uses bounds notation + using FullDim = fir::ArrayBoxValue; + + // CHARACTER type variable with its dependent type LEN parameter + using Char = fir::CharBoxValue; + + // CHARACTER array variable using bounds notation + using CharFullDim = fir::CharArrayBoxValue; + + // Pointer or allocatable variable + using PointerOrAllocatable = fir::MutableBoxValue; + + // Non pointer/allocatable variable that must be tracked with + // a fir.box (either because it is not contiguous, or assumed rank, or assumed + // type, or polymorphic, or because the fir.box is describing an optional + // value and cannot be read into one of the other category when lowering the + // symbol). + using Box = fir::BoxValue; + + using VT = std::variant; + + //===--------------------------------------------------------------------===// + // Constructors + //===--------------------------------------------------------------------===// + + SymbolBox() : box{None{}} {} + template + SymbolBox(const A &x) : box{x} {} + + explicit operator bool() const { return !std::holds_alternative(box); } + + fir::ExtendedValue toExtendedValue() const { + return match( + [](const Fortran::lower::SymbolBox::Intrinsic &box) + -> fir::ExtendedValue { return box.getAddr(); }, + [](const Fortran::lower::SymbolBox::None &) -> fir::ExtendedValue { + llvm::report_fatal_error("symbol not mapped"); + }, + [](const auto &box) -> fir::ExtendedValue { return box; }); + } + + //===--------------------------------------------------------------------===// + // Accessors + //===--------------------------------------------------------------------===// + + /// Get address of the boxed value. For a scalar, this is the address of the + /// scalar. For an array, this is the address of the first element in the + /// array, etc. + mlir::Value getAddr() const { + return match([](const None &) { return mlir::Value{}; }, + [](const auto &x) { return x.getAddr(); }); + } + + /// Does the boxed value have an intrinsic type? + bool isIntrinsic() const { + return match([](const Intrinsic &) { return true; }, + [](const Char &) { return true; }, + [](const PointerOrAllocatable &x) { + return !x.isDerived() && !x.isUnlimitedPolymorphic(); + }, + [](const Box &x) { + return !x.isDerived() && !x.isUnlimitedPolymorphic(); + }, + [](const auto &x) { return false; }); + } + + /// Does the boxed value have a rank greater than zero? + bool hasRank() const { + return match([](const Intrinsic &) { return false; }, + [](const Char &) { return false; }, + [](const None &) { return false; }, + [](const PointerOrAllocatable &x) { return x.hasRank(); }, + [](const Box &x) { return x.hasRank(); }, + [](const auto &x) { return x.getExtents().size() > 0; }); + } + + /// Does the boxed value have trivial lower bounds (== 1)? + bool hasSimpleLBounds() const { + return match( + [](const FullDim &arr) { return arr.getLBounds().empty(); }, + [](const CharFullDim &arr) { return arr.getLBounds().empty(); }, + [](const Box &arr) { return arr.getLBounds().empty(); }, + [](const auto &) { return false; }); + } + + /// Does the boxed value have a constant shape? + bool hasConstantShape() const { + if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType())) + if (auto arrTy = eleTy.dyn_cast()) + return arrTy.hasConstantShape(); + return false; + } + + /// Get the lbound if the box explicitly contains it. + mlir::Value getLBound(unsigned dim) const { + return match([&](const FullDim &box) { return box.getLBounds()[dim]; }, + [&](const CharFullDim &box) { return box.getLBounds()[dim]; }, + [&](const Box &box) { return box.getLBounds()[dim]; }, + [](const auto &) { return mlir::Value{}; }); + } + + /// Apply the lambda `func` to this box value. + template + constexpr RT apply(RT(&&func)(const ON &)) const { + if (auto *x = std::get_if(&box)) + return func(*x); + return RT{}; + } + + const VT &matchee() const { return box; } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &os, + const SymbolBox &symBox); + + /// Dump the map. For debugging. + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; } + +private: + VT box; +}; + +//===----------------------------------------------------------------------===// +// Map of symbol information +//===----------------------------------------------------------------------===// + +/// Helper class to map front-end symbols to their MLIR representation. This +/// provides a way to lookup the ssa-values that comprise a Fortran symbol's +/// runtime attributes. These attributes include its address, its dynamic size, +/// dynamic bounds information for non-scalar entities, dynamic type parameters, +/// etc. +class SymMap { +public: + using AcDoVar = llvm::StringRef; + + SymMap() { pushScope(); } + SymMap(const SymMap &) = delete; + + void pushScope() { symbolMapStack.emplace_back(); } + void popScope() { + symbolMapStack.pop_back(); + assert(symbolMapStack.size() >= 1); + } + + /// Add an extended value to the symbol table. + void addSymbol(semantics::SymbolRef sym, const fir::ExtendedValue &ext, + bool force = false); + + /// Add a trivial symbol mapping to an address. + void addSymbol(semantics::SymbolRef sym, mlir::Value value, + bool force = false) { + makeSym(sym, SymbolBox::Intrinsic(value), force); + } + + /// Add a scalar CHARACTER mapping to an (address, len). + void addCharSymbol(semantics::SymbolRef sym, mlir::Value value, + mlir::Value len, bool force = false) { + makeSym(sym, SymbolBox::Char(value, len), force); + } + void addCharSymbol(semantics::SymbolRef sym, const SymbolBox::Char &value, + bool force = false) { + makeSym(sym, value, force); + } + + /// Add an array mapping with (address, shape). + void addSymbolWithShape(semantics::SymbolRef sym, mlir::Value value, + llvm::ArrayRef shape, + bool force = false) { + makeSym(sym, SymbolBox::FullDim(value, shape), force); + } + void addSymbolWithShape(semantics::SymbolRef sym, + const SymbolBox::FullDim &value, bool force = false) { + makeSym(sym, value, force); + } + + /// Add an array of CHARACTER mapping. + void addCharSymbolWithShape(semantics::SymbolRef sym, mlir::Value value, + mlir::Value len, + llvm::ArrayRef shape, + bool force = false) { + makeSym(sym, SymbolBox::CharFullDim(value, len, shape), force); + } + void addCharSymbolWithShape(semantics::SymbolRef sym, + const SymbolBox::CharFullDim &value, + bool force = false) { + makeSym(sym, value, force); + } + + /// Add an array mapping with bounds notation. + void addSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value, + llvm::ArrayRef extents, + llvm::ArrayRef lbounds, + bool force = false) { + makeSym(sym, SymbolBox::FullDim(value, extents, lbounds), force); + } + void addSymbolWithBounds(semantics::SymbolRef sym, + const SymbolBox::FullDim &value, + bool force = false) { + makeSym(sym, value, force); + } + + /// Add an array of CHARACTER with bounds notation. + void addCharSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value, + mlir::Value len, + llvm::ArrayRef extents, + llvm::ArrayRef lbounds, + bool force = false) { + makeSym(sym, SymbolBox::CharFullDim(value, len, extents, lbounds), force); + } + void addCharSymbolWithBounds(semantics::SymbolRef sym, + const SymbolBox::CharFullDim &value, + bool force = false) { + makeSym(sym, value, force); + } + + void addAllocatableOrPointer(semantics::SymbolRef sym, + fir::MutableBoxValue box, bool force = false) { + makeSym(sym, box, force); + } + + void addBoxSymbol(semantics::SymbolRef sym, mlir::Value irBox, + llvm::ArrayRef lbounds, + llvm::ArrayRef explicitParams, + llvm::ArrayRef explicitExtents, + bool force = false) { + makeSym(sym, + SymbolBox::Box(irBox, lbounds, explicitParams, explicitExtents), + force); + } + void addBoxSymbol(semantics::SymbolRef sym, const SymbolBox::Box &value, + bool force = false) { + makeSym(sym, value, force); + } + + /// Find `symbol` and return its value if it appears in the current mappings. + SymbolBox lookupSymbol(semantics::SymbolRef sym); + SymbolBox lookupSymbol(const semantics::Symbol *sym) { + return lookupSymbol(*sym); + } + + /// Add a new binding from the ac-do-variable `var` to `value`. + void pushImpliedDoBinding(AcDoVar var, mlir::Value value) { + impliedDoStack.emplace_back(var, value); + } + + /// Pop the most recent implied do binding off the stack. + void popImpliedDoBinding() { + assert(!impliedDoStack.empty()); + impliedDoStack.pop_back(); + } + + /// Lookup the ac-do-variable and return the Value it is bound to. + /// If the variable is not found, returns a null Value. + mlir::Value lookupImpliedDo(AcDoVar var); + + /// Remove all symbols from the map. + void clear() { + symbolMapStack.clear(); + symbolMapStack.emplace_back(); + assert(symbolMapStack.size() == 1); + impliedDoStack.clear(); + } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &os, + const SymMap &symMap); + + /// Dump the map. For debugging. + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; } + +private: + /// Add `symbol` to the current map and bind a `box`. + void makeSym(semantics::SymbolRef sym, const SymbolBox &box, + bool force = false) { + if (force) + symbolMapStack.back().erase(&*sym); + assert(box && "cannot add an undefined symbol box"); + symbolMapStack.back().try_emplace(&*sym, box); + } + + llvm::SmallVector> + symbolMapStack; + + // Implied DO induction variables are not represented as Se::Symbol in + // Ev::Expr. Keep the variable markers in their own stack. + llvm::SmallVector> impliedDoStack; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_SYMBOLMAP_H diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h --- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h +++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h @@ -74,6 +74,9 @@ return "fir.char_proc"; } +/// Attribute to keep track of Fortran scoping information for a symbol. +static constexpr llvm::StringRef getSymbolAttrName() { return "fir.sym_name"; } + /// Tell if \p value is: /// - a function argument that has attribute \p attributeName /// - or, the result of fir.alloca/fir.allocamem op that has attribute \p diff --git a/flang/include/flang/Optimizer/Support/Utils.h b/flang/include/flang/Optimizer/Support/Utils.h --- a/flang/include/flang/Optimizer/Support/Utils.h +++ b/flang/include/flang/Optimizer/Support/Utils.h @@ -13,6 +13,8 @@ #ifndef FORTRAN_OPTIMIZER_SUPPORT_UTILS_H #define FORTRAN_OPTIMIZER_SUPPORT_UTILS_H +#include "flang/Common/default-kinds.h" +#include "flang/Optimizer/Dialect/FIRType.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" #include "mlir/IR/BuiltinAttributes.h" @@ -21,6 +23,22 @@ inline std::int64_t toInt(mlir::arith::ConstantOp cop) { return cop.getValue().cast().getValue().getSExtValue(); } + +// Translate front-end KINDs for use in the IR and code gen. +inline std::vector +fromDefaultKinds(const Fortran::common::IntrinsicTypeDefaultKinds &defKinds) { + return {static_cast(defKinds.GetDefaultKind( + Fortran::common::TypeCategory::Character)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Complex)), + static_cast(defKinds.doublePrecisionKind()), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Integer)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Logical)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Real))}; +} } // namespace fir #endif // FORTRAN_OPTIMIZER_SUPPORT_UTILS_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/Bridge.cpp @@ -0,0 +1,306 @@ +//===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Bridge.h" +#include "flang/Evaluate/tools.h" +#include "flang/Lower/CallInterface.h" +#include "flang/Lower/Mangler.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/SymbolMap.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Support/FIRContext.h" +#include "mlir/IR/PatternMatch.h" +#include "mlir/Transforms/RegionUtils.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-bridge" + +static llvm::cl::opt dumpBeforeFir( + "fdebug-dump-pre-fir", llvm::cl::init(false), + llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); + +//===----------------------------------------------------------------------===// +// FirConverter +//===----------------------------------------------------------------------===// + +namespace { + +/// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR. +class FirConverter : public Fortran::lower::AbstractConverter { +public: + explicit FirConverter(Fortran::lower::LoweringBridge &bridge) + : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {} + virtual ~FirConverter() = default; + + /// Convert the PFT to FIR. + void run(Fortran::lower::pft::Program &pft) { + // Primary translation pass. + for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) { + std::visit( + Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) {}, + [&](Fortran::lower::pft::BlockDataUnit &b) {}, + [&](Fortran::lower::pft::CompilerDirectiveUnit &d) { + setCurrentPosition( + d.get().source); + mlir::emitWarning(toLocation(), + "ignoring all compiler directives"); + }, + }, + u); + } + } + + //===--------------------------------------------------------------------===// + // AbstractConverter overrides + //===--------------------------------------------------------------------===// + + mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final { + return lookupSymbol(sym).getAddr(); + } + + mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Value genExprValue(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + + Fortran::evaluate::FoldingContext &getFoldingContext() override final { + return foldingContext; + } + + mlir::Type genType(const Fortran::evaluate::DataRef &) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Type genType(const Fortran::lower::SomeExpr &) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Type genType(Fortran::lower::SymbolRef) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Type genType(Fortran::common::TypeCategory tc) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Type genType(Fortran::common::TypeCategory tc, + int kind) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + mlir::Type genType(const Fortran::lower::pft::Variable &) override final { + TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + } + + void setCurrentPosition(const Fortran::parser::CharBlock &position) { + if (position != Fortran::parser::CharBlock{}) + currentPosition = position; + } + + //===--------------------------------------------------------------------===// + // Utility methods + //===--------------------------------------------------------------------===// + + /// Convert a parser CharBlock to a Location + mlir::Location toLocation(const Fortran::parser::CharBlock &cb) { + return genLocation(cb); + } + + mlir::Location toLocation() { return toLocation(currentPosition); } + void setCurrentEval(Fortran::lower::pft::Evaluation &eval) { + evalPtr = &eval; + } + + mlir::Location getCurrentLocation() override final { return toLocation(); } + + /// Generate a dummy location. + mlir::Location genUnknownLocation() override final { + // Note: builder may not be instantiated yet + return mlir::UnknownLoc::get(&getMLIRContext()); + } + + /// Generate a `Location` from the `CharBlock`. + mlir::Location + genLocation(const Fortran::parser::CharBlock &block) override final { + if (const Fortran::parser::AllCookedSources *cooked = + bridge.getCookedSource()) { + if (std::optional> + loc = cooked->GetSourcePositionRange(block)) { + // loc is a pair (begin, end); use the beginning position + Fortran::parser::SourcePosition &filePos = loc->first; + return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(), + filePos.line, filePos.column); + } + } + return genUnknownLocation(); + } + + fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; } + + mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); } + + mlir::MLIRContext &getMLIRContext() override final { + return bridge.getMLIRContext(); + } + std::string + mangleName(const Fortran::semantics::Symbol &symbol) override final { + return Fortran::lower::mangle::mangleName(symbol); + } + + const fir::KindMapping &getKindMap() override final { + return bridge.getKindMap(); + } + + /// Return the predicate: "current block does not have a terminator branch". + bool blockIsUnterminated() { + mlir::Block *currentBlock = builder->getBlock(); + return currentBlock->empty() || + !currentBlock->back().hasTrait(); + } + + /// Emit return and cleanup after the function has been translated. + void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt)); + if (funit.isMainProgram()) + genExitRoutine(); + funit.finalBlock = nullptr; + LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n" + << *builder->getFunction() << '\n'); + delete builder; + builder = nullptr; + localSymbols.clear(); + } + + /// Prepare to translate a new function + void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + assert(!builder && "expected nullptr"); + Fortran::lower::CalleeInterface callee(funit, *this); + mlir::FuncOp func = callee.addEntryBlockAndMapArguments(); + func.setVisibility(mlir::SymbolTable::Visibility::Public); + builder = new fir::FirOpBuilder(func, bridge.getKindMap()); + assert(builder && "FirOpBuilder did not instantiate"); + builder->setInsertionPointToStart(&func.front()); + } + + /// Lower a procedure (nest). + void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { + setCurrentPosition(funit.getStartingSourceLoc()); + for (int entryIndex = 0, last = funit.entryPointList.size(); + entryIndex < last; ++entryIndex) { + funit.setActiveEntry(entryIndex); + startNewFunction(funit); // the entry point for lowering this procedure + endNewFunction(funit); + } + funit.setActiveEntry(0); + for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions) + lowerFunc(f); // internal procedure + } + +private: + FirConverter() = delete; + FirConverter(const FirConverter &) = delete; + FirConverter &operator=(const FirConverter &) = delete; + + //===--------------------------------------------------------------------===// + // Helper member functions + //===--------------------------------------------------------------------===// + + /// Find the symbol in the local map or return null. + Fortran::lower::SymbolBox + lookupSymbol(const Fortran::semantics::Symbol &sym) { + if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym)) + return v; + return {}; + } + + //===--------------------------------------------------------------------===// + // Termination of symbolically referenced execution units + //===--------------------------------------------------------------------===// + + /// END of program + /// + /// Generate the cleanup block before the program exits + void genExitRoutine() { + if (blockIsUnterminated()) + builder->create(toLocation()); + } + void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); } + + //===--------------------------------------------------------------------===// + + Fortran::lower::LoweringBridge &bridge; + Fortran::evaluate::FoldingContext foldingContext; + fir::FirOpBuilder *builder = nullptr; + Fortran::lower::pft::Evaluation *evalPtr = nullptr; + Fortran::lower::SymMap localSymbols; + Fortran::parser::CharBlock currentPosition; +}; + +} // namespace + +Fortran::evaluate::FoldingContext +Fortran::lower::LoweringBridge::createFoldingContext() const { + return {getDefaultKinds(), getIntrinsicTable()}; +} + +void Fortran::lower::LoweringBridge::lower( + const Fortran::parser::Program &prg, + const Fortran::semantics::SemanticsContext &semanticsContext) { + std::unique_ptr pft = + Fortran::lower::createPFT(prg, semanticsContext); + if (dumpBeforeFir) + Fortran::lower::dumpPFT(llvm::errs(), *pft); + FirConverter converter{*this}; + converter.run(*pft); +} + +Fortran::lower::LoweringBridge::LoweringBridge( + mlir::MLIRContext &context, + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, + fir::KindMapping &kindMap) + : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, + context{context}, kindMap{kindMap} { + // Register the diagnostic handler. + context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { + llvm::raw_ostream &os = llvm::errs(); + switch (diag.getSeverity()) { + case mlir::DiagnosticSeverity::Error: + os << "error: "; + break; + case mlir::DiagnosticSeverity::Remark: + os << "info: "; + break; + case mlir::DiagnosticSeverity::Warning: + os << "warning: "; + break; + default: + break; + } + if (!diag.getLocation().isa()) + os << diag.getLocation() << ": "; + os << diag << '\n'; + os.flush(); + return mlir::success(); + }); + + // Create the module and attach the attributes. + module = std::make_unique( + mlir::ModuleOp::create(mlir::UnknownLoc::get(&context))); + assert(module.get() && "module was not created"); + fir::setTargetTriple(*module.get(), triple); + fir::setKindMapping(*module.get(), kindMap); +} 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 @@ -1,6 +1,8 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FortranLower + Bridge.cpp + CallInterface.cpp CharacterExpr.cpp CharacterRuntime.cpp Coarray.cpp @@ -13,6 +15,7 @@ OpenACC.cpp OpenMP.cpp PFTBuilder.cpp + SymbolMap.cpp DEPENDS FIRDialect diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/CallInterface.cpp @@ -0,0 +1,116 @@ +//===-- CallInterface.cpp -- Procedure call interface ---------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/CallInterface.h" +#include "flang/Evaluate/fold.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/Mangler.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Support/Utils.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Semantics/symbol.h" +#include "flang/Semantics/tools.h" + +//===----------------------------------------------------------------------===// +// BIND(C) mangling helpers +//===----------------------------------------------------------------------===// + +// Return the binding label (from BIND(C...)) or the mangled name of a symbol. +static std::string getMangledName(const Fortran::semantics::Symbol &symbol) { + const std::string *bindName = symbol.GetBindName(); + return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol); +} + +//===----------------------------------------------------------------------===// +// Callee side interface implementation +//===----------------------------------------------------------------------===// + +std::string Fortran::lower::CalleeInterface::getMangledName() const { + if (funit.isMainProgram()) + return fir::NameUniquer::doProgramEntry().str(); + return ::getMangledName(funit.getSubprogramSymbol()); +} + +const Fortran::semantics::Symbol * +Fortran::lower::CalleeInterface::getProcedureSymbol() const { + if (funit.isMainProgram()) + return nullptr; + return &funit.getSubprogramSymbol(); +} + +mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const { + // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably + // should just stash the location in the funit regardless. + return converter.genLocation(funit.getStartingSourceLoc()); +} + +mlir::FuncOp Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() { + // On the callee side, directly map the mlir::value argument of + // the function block to the Fortran symbols. + func.addEntryBlock(); + return func; +} + +//===----------------------------------------------------------------------===// +// CallInterface implementation: this part is common to both callee and caller +// sides. +//===----------------------------------------------------------------------===// + +static void addSymbolAttribute(mlir::FuncOp func, + const Fortran::semantics::Symbol &sym, + mlir::MLIRContext &mlirContext) { + // Only add this on bind(C) functions for which the symbol is not reflected in + // the current context. + if (!Fortran::semantics::IsBindCProcedure(sym)) + return; + std::string name = + Fortran::lower::mangle::mangleName(sym, /*keepExternalInScope=*/true); + func->setAttr(fir::getSymbolAttrName(), + mlir::StringAttr::get(&mlirContext, name)); +} + +/// Declare drives the different actions to be performed while analyzing the +/// signature and building/finding the mlir::FuncOp. +template +void Fortran::lower::CallInterface::declare() { + // Create / get funcOp for direct calls. For indirect calls (only meaningful + // on the caller side), no funcOp has to be created here. The mlir::Value + // holding the indirection is used when creating the fir::CallOp. + if (!side().isIndirectCall()) { + std::string name = side().getMangledName(); + mlir::ModuleOp module = converter.getModuleOp(); + func = fir::FirOpBuilder::getNamedFunction(module, name); + if (!func) { + mlir::Location loc = side().getCalleeLocation(); + mlir::FunctionType ty = genFunctionType(); + func = fir::FirOpBuilder::createFunction(loc, module, name, ty); + if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol()) + addSymbolAttribute(func, *sym, converter.getMLIRContext()); + for (const auto &placeHolder : llvm::enumerate(inputs)) + if (!placeHolder.value().attributes.empty()) + func.setArgAttrs(placeHolder.index(), placeHolder.value().attributes); + } + } +} + +template +mlir::FunctionType Fortran::lower::CallInterface::genFunctionType() { + llvm::SmallVector returnTys; + llvm::SmallVector inputTys; + for (const FirPlaceHolder &placeHolder : outputs) + returnTys.emplace_back(placeHolder.type); + for (const FirPlaceHolder &placeHolder : inputs) + inputTys.emplace_back(placeHolder.type); + return mlir::FunctionType::get(&converter.getMLIRContext(), inputTys, + returnTys); +} + +template class Fortran::lower::CallInterface; 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 @@ -10,6 +10,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/DoLoopHelper.h" #include "flang/Lower/IntrinsicCall.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" //===----------------------------------------------------------------------===// // CharacterExprHelper implementation diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp --- a/flang/lib/Lower/Coarray.cpp +++ b/flang/lib/Lower/Coarray.cpp @@ -12,8 +12,8 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Coarray.h" -#include "SymbolMap.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/expression.h" diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -14,8 +14,8 @@ #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/PFTBuilder.h" -#include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" @@ -910,7 +910,8 @@ } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_shutdown) { genACCInitShutdownOp(converter, accClauseList); } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_set) { - TODO(converter.genLocation(), "OpenACC set directive not lowered yet!"); + TODO(converter.getCurrentLocation(), + "OpenACC set directive not lowered yet!"); } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_update) { genACCUpdateOp(converter, accClauseList); } @@ -1003,7 +1004,7 @@ }, [&](const Fortran::parser::OpenACCCombinedConstruct &combinedConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Combined construct not lowered yet!"); }, [&](const Fortran::parser::OpenACCLoopConstruct &loopConstruct) { @@ -1015,18 +1016,18 @@ }, [&](const Fortran::parser::OpenACCRoutineConstruct &routineConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Routine construct not lowered yet!"); }, [&](const Fortran::parser::OpenACCCacheConstruct &cacheConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Cache construct not lowered yet!"); }, [&](const Fortran::parser::OpenACCWaitConstruct &waitConstruct) { genACC(converter, eval, waitConstruct); }, [&](const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Atomic construct not lowered yet!"); }, }, diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -14,8 +14,8 @@ #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/PFTBuilder.h" -#include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h deleted file mode 100644 --- a/flang/lib/Lower/SymbolMap.h +++ /dev/null @@ -1,249 +0,0 @@ -//===-- SymbolMap.h -- lowering internal symbol map -------------*- 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_SYMBOLMAP_H -#define FORTRAN_LOWER_SYMBOLMAP_H - -#include "flang/Common/idioms.h" -#include "flang/Common/reference.h" -#include "flang/Optimizer/Builder/BoxValue.h" -#include "flang/Optimizer/Dialect/FIRType.h" -#include "flang/Semantics/symbol.h" -#include "mlir/IR/Value.h" -#include "llvm/ADT/ArrayRef.h" -#include "llvm/ADT/DenseMap.h" -#include "llvm/ADT/Optional.h" -#include "llvm/ADT/SmallVector.h" -#include "llvm/Support/Compiler.h" - -namespace Fortran::lower { - -//===----------------------------------------------------------------------===// -// Symbol information -//===----------------------------------------------------------------------===// - -/// A dictionary entry of ssa-values that together compose a variable referenced -/// by a Symbol. For example, the declaration -/// -/// CHARACTER(LEN=i) :: c(j1,j2) -/// -/// is a single variable `c`. This variable is a two-dimensional array of -/// CHARACTER. It has a starting address and three dynamic properties: the LEN -/// parameter `i` a runtime value describing the length of the CHARACTER, and -/// the `j1` and `j2` runtime values, which describe the shape of the array. -/// -/// The lowering bridge needs to be able to record all four of these ssa-values -/// in the lookup table to be able to correctly lower Fortran to FIR. -struct SymbolBox { - // For lookups that fail, have a monostate - using None = std::monostate; - - // Trivial intrinsic type - using Intrinsic = fir::AbstractBox; - - // Array variable that uses bounds notation - using FullDim = fir::ArrayBoxValue; - - // CHARACTER type variable with its dependent type LEN parameter - using Char = fir::CharBoxValue; - - // CHARACTER array variable using bounds notation - using CharFullDim = fir::CharArrayBoxValue; - - // Generalized derived type variable - using Derived = fir::BoxValue; - - //===--------------------------------------------------------------------===// - // Constructors - //===--------------------------------------------------------------------===// - - SymbolBox() : box{None{}} {} - template - SymbolBox(const A &x) : box{x} {} - - operator bool() const { return !std::holds_alternative(box); } - - // This operator returns the address of the boxed value. TODO: consider - // eliminating this in favor of explicit conversion. - operator mlir::Value() const { return getAddr(); } - - //===--------------------------------------------------------------------===// - // Accessors - //===--------------------------------------------------------------------===// - - /// Get address of the boxed value. For a scalar, this is the address of the - /// scalar. For an array, this is the address of the first element in the - /// array, etc. - mlir::Value getAddr() const { - return std::visit(common::visitors{ - [](const None &) { return mlir::Value{}; }, - [](const auto &x) { return x.getAddr(); }, - }, - box); - } - - /// Get the LEN type parameter of a CHARACTER boxed value. - llvm::Optional getCharLen() const { - using T = llvm::Optional; - return std::visit(common::visitors{ - [](const Char &x) { return T{x.getLen()}; }, - [](const CharFullDim &x) { return T{x.getLen()}; }, - [](const auto &) { return T{}; }, - }, - box); - } - - /// Does the boxed value have an intrinsic type? - bool isIntrinsic() const { - return std::visit(common::visitors{ - [](const Intrinsic &) { return true; }, - [](const Char &) { return true; }, - [](const auto &x) { return false; }, - }, - box); - } - - /// Does the boxed value have a rank greater than zero? - bool hasRank() const { - return std::visit( - common::visitors{ - [](const Intrinsic &) { return false; }, - [](const Char &) { return false; }, - [](const None &) { return false; }, - [](const auto &x) { return x.getExtents().size() > 0; }, - }, - box); - } - - /// Does the boxed value have trivial lower bounds (== 1)? - bool hasSimpleLBounds() const { - if (auto *arr = std::get_if(&box)) - return arr->getLBounds().empty(); - if (auto *arr = std::get_if(&box)) - return arr->getLBounds().empty(); - if (auto *arr = std::get_if(&box)) - return (arr->getExtents().size() > 0) && arr->getLBounds().empty(); - return false; - } - - /// Does the boxed value have a constant shape? - bool hasConstantShape() const { - if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType())) - if (auto arrTy = eleTy.dyn_cast()) - return arrTy.hasConstantShape(); - return false; - } - - /// Get the lbound if the box explicitly contains it. - mlir::Value getLBound(unsigned dim) const { - return std::visit( - common::visitors{ - [&](const FullDim &box) { return box.getLBounds()[dim]; }, - [&](const CharFullDim &box) { return box.getLBounds()[dim]; }, - [&](const Derived &box) { return box.getLBounds()[dim]; }, - [](const auto &) { return mlir::Value{}; }}, - box); - } - - /// Apply the lambda `func` to this box value. - template - constexpr RT apply(RT(&&func)(const ON &)) const { - if (auto *x = std::get_if(&box)) - return func(*x); - return RT{}; - } - - std::variant box; -}; - -//===----------------------------------------------------------------------===// -// Map of symbol information -//===----------------------------------------------------------------------===// - -/// Helper class to map front-end symbols to their MLIR representation. This -/// provides a way to lookup the ssa-values that comprise a Fortran symbol's -/// runtime attributes. These attributes include its address, its dynamic size, -/// dynamic bounds information for non-scalar entities, dynamic type parameters, -/// etc. -class SymMap { -public: - /// Add a trivial symbol mapping to an address. - void addSymbol(semantics::SymbolRef sym, mlir::Value value, - bool force = false) { - makeSym(sym, SymbolBox::Intrinsic(value), force); - } - - /// Add a scalar CHARACTER mapping to an (address, len). - void addCharSymbol(semantics::SymbolRef sym, mlir::Value value, - mlir::Value len, bool force = false) { - makeSym(sym, SymbolBox::Char(value, len), force); - } - - /// Add an array mapping with (address, shape). - void addSymbolWithShape(semantics::SymbolRef sym, mlir::Value value, - llvm::ArrayRef shape, - bool force = false) { - makeSym(sym, SymbolBox::FullDim(value, shape), force); - } - - /// Add an array of CHARACTER mapping. - void addCharSymbolWithShape(semantics::SymbolRef sym, mlir::Value value, - mlir::Value len, - llvm::ArrayRef shape, - bool force = false) { - makeSym(sym, SymbolBox::CharFullDim(value, len, shape), force); - } - - /// Add an array mapping with bounds notation. - void addSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value, - llvm::ArrayRef extents, - llvm::ArrayRef lbounds, - bool force = false) { - makeSym(sym, SymbolBox::FullDim(value, extents, lbounds), force); - } - - /// Add an array of CHARACTER with bounds notation. - void addCharSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value, - mlir::Value len, - llvm::ArrayRef extents, - llvm::ArrayRef lbounds, - bool force = false) { - makeSym(sym, SymbolBox::CharFullDim(value, len, extents, lbounds), force); - } - - /// Find `symbol` and return its value if it appears in the current mappings. - SymbolBox lookupSymbol(semantics::SymbolRef sym) { - auto iter = symbolMap.find(&*sym); - return (iter == symbolMap.end()) ? SymbolBox() : iter->second; - } - - /// Remove `sym` from the map. - void erase(semantics::SymbolRef sym) { symbolMap.erase(&*sym); } - - /// Remove all symbols from the map. - void clear() { symbolMap.clear(); } - - /// Dump the map. For debugging. - LLVM_DUMP_METHOD void dump() const; - -private: - /// Add `symbol` to the current map and bind a `box`. - void makeSym(semantics::SymbolRef sym, const SymbolBox &box, - bool force = false) { - if (force) - erase(sym); - assert(box && "cannot add an undefined symbol box"); - symbolMap.try_emplace(&*sym, box); - } - - llvm::DenseMap symbolMap; -}; - -} // namespace Fortran::lower - -#endif // FORTRAN_LOWER_SYMBOLMAP_H diff --git a/flang/lib/Lower/SymbolMap.cpp b/flang/lib/Lower/SymbolMap.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/SymbolMap.cpp @@ -0,0 +1,78 @@ +//===-- SymbolMap.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 +// +//===----------------------------------------------------------------------===// +// +// Pretty printers for symbol boxes, etc. +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/SymbolMap.h" +#include "mlir/IR/BuiltinTypes.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-symbol-map" + +void Fortran::lower::SymMap::addSymbol(Fortran::semantics::SymbolRef sym, + const fir::ExtendedValue &exv, + bool force) { + exv.match([&](const fir::UnboxedValue &v) { addSymbol(sym, v, force); }, + [&](const fir::CharBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::ArrayBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::CharArrayBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::BoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::MutableBoxValue &v) { makeSym(sym, v, force); }, + [](auto) { + llvm::report_fatal_error("value not added to symbol table"); + }); +} + +Fortran::lower::SymbolBox +Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef sym) { + for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend(); + jmap != jend; ++jmap) { + auto iter = jmap->find(&*sym); + if (iter != jmap->end()) + return iter->second; + } + return SymbolBox::None{}; +} + +mlir::Value +Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) { + for (auto [marker, binding] : llvm::reverse(impliedDoStack)) + if (var == marker) + return binding; + return {}; +} + +llvm::raw_ostream & +Fortran::lower::operator<<(llvm::raw_ostream &os, + const Fortran::lower::SymbolBox &symBox) { + symBox.match( + [&](const Fortran::lower::SymbolBox::None &box) { + os << "** symbol not properly mapped **\n"; + }, + [&](const Fortran::lower::SymbolBox::Intrinsic &val) { + os << val.getAddr() << '\n'; + }, + [&](const auto &box) { os << box << '\n'; }); + return os; +} + +llvm::raw_ostream & +Fortran::lower::operator<<(llvm::raw_ostream &os, + const Fortran::lower::SymMap &symMap) { + os << "Symbol map:\n"; + for (auto i : llvm::enumerate(symMap.symbolMapStack)) { + os << " level " << i.index() << "<{\n"; + for (auto iter : i.value()) + os << " symbol @" << static_cast(iter.first) << " [" + << *iter.first << "] ->\n " << iter.second; + os << " }>\n"; + } + return os; +} diff --git a/flang/test/CMakeLists.txt b/flang/test/CMakeLists.txt --- a/flang/test/CMakeLists.txt +++ b/flang/test/CMakeLists.txt @@ -46,7 +46,7 @@ flang_site_config=${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg.py) set(FLANG_TEST_DEPENDS - flang-new llvm-config FileCheck count not module_files fir-opt tco + flang-new llvm-config FileCheck count not module_files fir-opt tco bbc ) if (FLANG_INCLUDE_TESTS) diff --git a/flang/test/Lower/basic-program.f90 b/flang/test/Lower/basic-program.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/basic-program.f90 @@ -0,0 +1,13 @@ +! RUN: bbc %s --pft-test | FileCheck %s +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s --check-prefix=FIR + +program basic +end program + +! CHECK: 1 Program basic +! CHECK: 1 EndProgramStmt: end program +! CHECK: End Program basic + +! FIR-LABEL: func @_QQmain() { +! FIR: return +! FIR: } diff --git a/flang/tools/CMakeLists.txt b/flang/tools/CMakeLists.txt --- a/flang/tools/CMakeLists.txt +++ b/flang/tools/CMakeLists.txt @@ -6,6 +6,7 @@ # #===------------------------------------------------------------------------===# +add_subdirectory(bbc) add_subdirectory(f18) add_subdirectory(flang-driver) add_subdirectory(tco) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt new file mode 100644 --- /dev/null +++ b/flang/tools/bbc/CMakeLists.txt @@ -0,0 +1,22 @@ + +add_flang_tool(bbc bbc.cpp +DEPENDS +FIROptCodeGenPassIncGen +) + +llvm_update_compile_flags(bbc) +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) +target_link_libraries(bbc PRIVATE +FIRDialect +FIRSupport +FIRTransforms +FIRBuilder +${dialect_libs} +MLIRAffineToStandard +MLIRSCFToStandard +FortranCommon +FortranParser +FortranEvaluate +FortranSemantics +FortranLower +) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp new file mode 100644 --- /dev/null +++ b/flang/tools/bbc/bbc.cpp @@ -0,0 +1,253 @@ +//===- bbc.cpp - Burnside Bridge Compiler -----------------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +/// +/// This is a tool for translating Fortran sources to the FIR dialect of MLIR. +/// +//===----------------------------------------------------------------------===// + +#include "flang/Common/Fortran-features.h" +#include "flang/Common/default-kinds.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Support/Verifier.h" +#include "flang/Optimizer/Support/FIRContext.h" +#include "flang/Optimizer/Support/InitFIR.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "flang/Optimizer/Support/Utils.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "flang/Parser/characters.h" +#include "flang/Parser/dump-parse-tree.h" +#include "flang/Parser/message.h" +#include "flang/Parser/parse-tree-visitor.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Parser/parsing.h" +#include "flang/Parser/provenance.h" +#include "flang/Parser/unparse.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/runtime-type-info.h" +#include "flang/Semantics/semantics.h" +#include "flang/Semantics/unparse-with-symbols.h" +#include "flang/Version.inc" +#include "mlir/Conversion/SCFToStandard/SCFToStandard.h" +#include "mlir/IR/AsmState.h" +#include "mlir/IR/BuiltinOps.h" +#include "mlir/IR/MLIRContext.h" +#include "mlir/Parser.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassManager.h" +#include "mlir/Pass/PassRegistry.h" +#include "mlir/Transforms/GreedyPatternRewriteDriver.h" +#include "mlir/Transforms/Passes.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/ErrorOr.h" +#include "llvm/Support/FileSystem.h" +#include "llvm/Support/InitLLVM.h" +#include "llvm/Support/MemoryBuffer.h" +#include "llvm/Support/Path.h" +#include "llvm/Support/SourceMgr.h" +#include "llvm/Support/TargetSelect.h" +#include "llvm/Support/ToolOutputFile.h" +#include "llvm/Support/raw_ostream.h" + +//===----------------------------------------------------------------------===// +// Some basic command-line options +//===----------------------------------------------------------------------===// + +static llvm::cl::opt inputFilename(llvm::cl::Positional, + llvm::cl::Required, + llvm::cl::desc("")); + +static llvm::cl::opt + outputFilename("o", llvm::cl::desc("Specify the output filename"), + llvm::cl::value_desc("filename")); + +static llvm::cl::opt + emitFIR("emit-fir", + llvm::cl::desc("Dump the FIR created by lowering and exit"), + llvm::cl::init(false)); + +static llvm::cl::opt pftDumpTest( + "pft-test", + llvm::cl::desc("parse the input, create a PFT, dump it, and exit"), + llvm::cl::init(false)); + +#define FLANG_EXCLUDE_CODEGEN +#include "flang/Tools/CLOptions.inc" + +//===----------------------------------------------------------------------===// + +using ProgramName = std::string; + +// Print the module without the "module { ... }" wrapper. +static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { + for (auto &op : *mlirModule.getBody()) + out << op << '\n'; + out << '\n'; +} + +static void registerAllPasses() { + fir::support::registerMLIRPassesForFortranTools(); + fir::registerOptTransformPasses(); +} + +//===----------------------------------------------------------------------===// +// Translate Fortran input to FIR, a dialect of MLIR. +//===----------------------------------------------------------------------===// + +static mlir::LogicalResult convertFortranSourceToMLIR( + std::string path, Fortran::parser::Options options, + const ProgramName &programPrefix, + Fortran::semantics::SemanticsContext &semanticsContext, + const mlir::PassPipelineCLParser &passPipeline) { + + // prep for prescan and parse + Fortran::parser::Parsing parsing{semanticsContext.allCookedSources()}; + parsing.Prescan(path, options); + if (!parsing.messages().empty() && (parsing.messages().AnyFatalError())) { + llvm::errs() << programPrefix << "could not scan " << path << '\n'; + parsing.messages().Emit(llvm::errs(), parsing.allCooked()); + return mlir::failure(); + } + + // parse the input Fortran + parsing.Parse(llvm::outs()); + parsing.messages().Emit(llvm::errs(), parsing.allCooked()); + if (!parsing.consumedWholeFile()) { + parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), + "parser FAIL (final position)"); + return mlir::failure(); + } + if ((!parsing.messages().empty() && (parsing.messages().AnyFatalError())) || + !parsing.parseTree().has_value()) { + llvm::errs() << programPrefix << "could not parse " << path << '\n'; + return mlir::failure(); + } + + // run semantics + auto &parseTree = *parsing.parseTree(); + Fortran::semantics::Semantics semantics(semanticsContext, parseTree); + semantics.Perform(); + semantics.EmitMessages(llvm::errs()); + if (semantics.AnyFatalError()) { + llvm::errs() << programPrefix << "semantic errors in " << path << '\n'; + return mlir::failure(); + } + Fortran::semantics::RuntimeDerivedTypeTables tables; + if (!semantics.AnyFatalError()) { + tables = + Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext); + if (!tables.schemata) + llvm::errs() << programPrefix + << "could not find module file for __fortran_type_info\n"; + } + + if (pftDumpTest) { + if (auto ast = Fortran::lower::createPFT(parseTree, semanticsContext)) { + Fortran::lower::dumpPFT(llvm::outs(), *ast); + return mlir::success(); + } + llvm::errs() << "Pre FIR Tree is NULL.\n"; + return mlir::failure(); + } + + // translate to FIR dialect of MLIR + mlir::DialectRegistry registry; + fir::support::registerNonCodegenDialects(registry); + mlir::MLIRContext ctx(registry); + fir::support::loadNonCodegenDialects(ctx); + auto &defKinds = semanticsContext.defaultKinds(); + fir::KindMapping kindMap( + &ctx, llvm::ArrayRef{fir::fromDefaultKinds(defKinds)}); + auto burnside = Fortran::lower::LoweringBridge::create( + ctx, defKinds, semanticsContext.intrinsics(), parsing.allCooked(), "", + kindMap); + burnside.lower(parseTree, semanticsContext); + mlir::ModuleOp mlirModule = burnside.getModule(); + std::error_code ec; + std::string outputName = outputFilename; + if (!outputName.size()) + outputName = llvm::sys::path::stem(inputFilename).str().append(".mlir"); + llvm::raw_fd_ostream out(outputName, ec); + if (ec) + return mlir::emitError(mlir::UnknownLoc::get(&ctx), + "could not open output file ") + << outputName; + + // Otherwise run the default passes. + mlir::PassManager pm(&ctx, mlir::OpPassManager::Nesting::Implicit); + pm.enableVerifier(/*verifyPasses=*/true); + mlir::applyPassManagerCLOptions(pm); + if (passPipeline.hasAnyOccurrences()) { + // run the command-line specified pipeline + (void)passPipeline.addToPipeline(pm, [&](const llvm::Twine &msg) { + mlir::emitError(mlir::UnknownLoc::get(&ctx)) << msg; + return mlir::failure(); + }); + } else if (emitFIR) { + // --emit-fir: Build the IR, verify it, and dump the IR if the IR passes + // verification. Use --dump-module-on-failure to dump invalid IR. + pm.addPass(std::make_unique()); + if (mlir::failed(pm.run(mlirModule))) { + llvm::errs() << "FATAL: verification of lowering to FIR failed"; + return mlir::failure(); + } + printModule(mlirModule, out); + return mlir::success(); + } else { + // run the default canned pipeline + pm.addPass(std::make_unique()); + + // Add default optimizer pass pipeline. + fir::createDefaultFIROptimizerPassPipeline(pm); + } + + if (mlir::succeeded(pm.run(mlirModule))) { + // Emit MLIR and do not lower to LLVM IR. + printModule(mlirModule, out); + return mlir::success(); + } + // Something went wrong. Try to dump the MLIR module. + llvm::errs() << "oops, pass manager reported failure\n"; + return mlir::failure(); +} + +int main(int argc, char **argv) { + [[maybe_unused]] llvm::InitLLVM y(argc, argv); + registerAllPasses(); + + mlir::registerMLIRContextCLOptions(); + mlir::registerPassManagerCLOptions(); + mlir::PassPipelineCLParser passPipe("", "Compiler passes to run"); + llvm::cl::ParseCommandLineOptions(argc, argv, "Burnside Bridge Compiler\n"); + + ProgramName programPrefix; + programPrefix = argv[0] + ": "s; + + Fortran::parser::Options options; + options.predefinitions.emplace_back("__flang__", "1"); + options.predefinitions.emplace_back("__flang_major__", + FLANG_VERSION_MAJOR_STRING); + options.predefinitions.emplace_back("__flang_minor__", + FLANG_VERSION_MINOR_STRING); + options.predefinitions.emplace_back("__flang_patchlevel__", + FLANG_VERSION_PATCHLEVEL_STRING); + + Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; + Fortran::parser::AllSources allSources; + Fortran::parser::AllCookedSources allCookedSources(allSources); + Fortran::semantics::SemanticsContext semanticsContext{ + defaultKinds, options.features, allCookedSources}; + + return mlir::failed(convertFortranSourceToMLIR( + inputFilename, options, programPrefix, semanticsContext, passPipe)); +}