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,131 @@ +#include "flang/Lower/Bridge.h" +#include "flang/Evaluate/common.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Semantics/symbol.h" +#include "llvm/Support/CommandLine.h" + +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 { +/// Walk over the pre-FIR tree (PFT) and lower it to the FIR dialect of MLIR. +/// +/// After building the PFT, the FirConverter processes that representation +/// and lowers it to the FIR executable representation. +class FirConverter { +public: + explicit FirConverter(Fortran::lower::LoweringBridge &bridge, + fir::NameUniquer &uniquer) + : bridge{bridge}, uniquer{uniquer}, foldingContext{ + bridge.createFoldingContext()} {} + virtual ~FirConverter() = default; + + /// Convert the PFT to FIR + void run(Fortran::lower::pft::Program &pft) { + // do translation + for (auto &u : pft.getUnits()) { + std::visit(Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { + mlir::emitError(toLocation(), "FUNCTION not handled"); + llvm::report_fatal_error("not yet implemented"); + }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) { + mlir::emitError(toLocation(), "MODULE not handled"); + llvm::report_fatal_error("not yet implemented"); + }, + [&](Fortran::lower::pft::BlockDataUnit &) { + mlir::emitError(toLocation(), "BLOCK DATA not handled"); + llvm::report_fatal_error("not yet implemented"); + }, + }, + u); + } + } + +private: + /// Generate a `Location` from the `CharBlock`. + mlir::Location genLocation(const Fortran::parser::CharBlock &block) { + if (const auto *cooked = bridge.getCookedSource()) { + auto loc = cooked->GetSourcePositionRange(block); + if (loc.has_value()) { + // loc is a pair (begin, end); use the beginning position + auto &filePos = loc->first; + return mlir::FileLineColLoc::get(filePos.file.path(), filePos.line, + filePos.column, &getMLIRContext()); + } + } + return genLocation(); + } + + mlir::MLIRContext &getMLIRContext() { return bridge.getMLIRContext(); } + + /// Generate a dummy location. + mlir::Location genLocation() { + // Note: builder may not be instantiated yet + return mlir::UnknownLoc::get(&getMLIRContext()); + } + + /// Convert a parser CharBlock to a Location + mlir::Location toLocation(const Fortran::parser::CharBlock &cb) { + return genLocation(cb); + } + + mlir::Location toLocation() { return toLocation(currentPosition); } + + [[maybe_unused]] Fortran::lower::LoweringBridge &bridge; + [[maybe_unused]] fir::NameUniquer &uniquer; + Fortran::evaluate::FoldingContext foldingContext; + 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, fir::NameUniquer &uniquer, + const Fortran::semantics::SemanticsContext &semanticsContext) { + auto pft = Fortran::lower::createPFT(prg, semanticsContext); + if (dumpBeforeFir) + Fortran::lower::dumpPFT(llvm::errs(), *pft); + FirConverter converter{*this, uniquer}; + converter.run(*pft); +} + +Fortran::lower::LoweringBridge::LoweringBridge( + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::parser::CookedSource &cooked) + : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, + context{std::make_unique()}, kindMap{context.get()} { + context.get()->getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { + auto &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(); + }); + module = std::make_unique( + mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); +} 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 @@ -2,6 +2,7 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FortranLower + Bridge.cpp CharacterExpr.cpp CharacterRuntime.cpp Coarray.cpp diff --git a/flang/test/Lower/block-data.f90 b/flang/test/Lower/block-data.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/block-data.f90 @@ -0,0 +1,6 @@ +! RUN: not --crash bbc -o - %s 2>&1 | FileCheck %s + +block data +! CHECK: error: BLOCK DATA not handled +! CHECK: LLVM ERROR: not yet implemented +end block data diff --git a/flang/tools/CMakeLists.txt b/flang/tools/CMakeLists.txt --- a/flang/tools/CMakeLists.txt +++ b/flang/tools/CMakeLists.txt @@ -9,5 +9,6 @@ add_subdirectory(f18) if(LINK_WITH_FIR) add_subdirectory(tco) + add_subdirectory(bbc) endif() add_subdirectory(f18-parse-demo) 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,17 @@ +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +set(LIBS + FIROptimizer + ${dialect_libs} + MLIRLLVMIR + MLIRAffineToStandard + FortranCommon + FortranParser + FortranEvaluate + FortranSemantics + FortranLower + ) + +add_flang_tool(bbc bbc.cpp) +llvm_update_compile_flags(bbc) +target_link_libraries(bbc PRIVATE ${LIBS}) 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,203 @@ +#include "flang/Lower/Bridge.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Parser/parsing.h" +#include "flang/Semantics/semantics.h" +#include "mlir/IR/AsmState.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassManager.h" +#include "mlir/Transforms/Passes.h" +#include "llvm/Support/InitLLVM.h" +#include + +//===----------------------------------------------------------------------===// +// 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::list + includeDirs("I", llvm::cl::desc("include search paths")); + +static llvm::cl::opt + intrinsicModuleDir("intrinsic-module-directory", + llvm::cl::desc("intrinsic module directory")); + +static llvm::cl::opt + moduleDir("module", llvm::cl::desc("module output directory (default .)"), + llvm::cl::init(".")); + +static llvm::cl::opt + moduleSuffix("module-suffix", llvm::cl::desc("module file suffix override"), + llvm::cl::init(".mod")); + +static llvm::cl::opt warnStdViolation("Mstandard", + llvm::cl::desc("emit warnings"), + llvm::cl::init(false)); + +static llvm::cl::opt warnIsError("Werror", + llvm::cl::desc("warnings are errors"), + llvm::cl::init(false)); + +static llvm::cl::opt fixedForm("Mfixed", + llvm::cl::desc("used fixed form"), + llvm::cl::init(false)); + +static llvm::cl::opt freeForm("Mfree", llvm::cl::desc("used free form"), + llvm::cl::init(false)); + +static llvm::cl::opt dumpSymbols("dump-symbols", + llvm::cl::desc("dump the symbol table"), + 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)); + +using ProgramName = std::string; + +static int exitStatus{EXIT_SUCCESS}; + +// Print the module without the "module { ... }" wrapper. +static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { + for (auto &op : mlirModule.getBody()->without_terminator()) + out << op << '\n'; + out << '\n'; +} + +static void convertFortranSourceToMLIR( + std::string path, Fortran::parser::Options options, + const ProgramName &programPrefix, + Fortran::semantics::SemanticsContext &semanticsContext, + const mlir::PassPipelineCLParser &passPipeline) { + if (!(fixedForm || freeForm)) { + auto dot = path.rfind("."); + if (dot != std::string::npos) { + std::string suffix{path.substr(dot + 1)}; + options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; + } + } + // prep for prescan and parse + options.searchDirectories = includeDirs; + Fortran::parser::Parsing parsing{semanticsContext.allSources()}; + parsing.Prescan(path, options); + if (!parsing.messages().empty() && + (warnIsError || parsing.messages().AnyFatalError())) { + llvm::errs() << programPrefix << "could not scan " << path << '\n'; + parsing.messages().Emit(llvm::errs(), parsing.cooked()); + exitStatus = EXIT_FAILURE; + return; + } + + // parse the input Fortran + parsing.Parse(llvm::outs()); + parsing.messages().Emit(llvm::errs(), parsing.cooked()); + if (!parsing.consumedWholeFile()) { + parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), + "parser FAIL (final position)"); + exitStatus = EXIT_FAILURE; + return; + } + if ((!parsing.messages().empty() && + (warnIsError || parsing.messages().AnyFatalError())) || + !parsing.parseTree().has_value()) { + llvm::errs() << programPrefix << "could not parse " << path << '\n'; + exitStatus = EXIT_FAILURE; + return; + } + + // run semantics + auto &parseTree{*parsing.parseTree()}; + Fortran::semantics::Semantics semantics{semanticsContext, parseTree, + parsing.cooked()}; + semantics.Perform(); + semantics.EmitMessages(llvm::errs()); + if (semantics.AnyFatalError()) { + llvm::errs() << programPrefix << "semantic errors in " << path << '\n'; + exitStatus = EXIT_FAILURE; + return; + } + if (dumpSymbols) + semantics.DumpSymbols(llvm::outs()); + + if (pftDumpTest) { + if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { + Fortran::lower::dumpPFT(llvm::outs(), *ast); + } else { + llvm::errs() << "Pre FIR Tree is NULL.\n"; + exitStatus = EXIT_FAILURE; + } + return; + } + + // MLIR+FIR + fir::NameUniquer nameUniquer; + auto loweringBridge = Fortran::lower::LoweringBridge::create( + semanticsContext.defaultKinds(), semanticsContext.intrinsics(), + parsing.cooked()); + loweringBridge.lower(parseTree, nameUniquer, semanticsContext); + mlir::ModuleOp mlirModule = loweringBridge.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) { + llvm::errs() << "could not open output file " << outputName << '\n'; + return; + } + + printModule(mlirModule, out); +} + +int main(int argc, char **argv) { + fir::registerFIR(); + [[maybe_unused]] llvm::InitLLVM y(argc, argv); + + mlir::registerAsmPrinterCLOptions(); + 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; + + if (includeDirs.size() == 0) + includeDirs.push_back("."); + + if (!intrinsicModuleDir.empty()) { + includeDirs.insert(includeDirs.begin(), intrinsicModuleDir); + } + + Fortran::parser::Options options; + options.predefinitions.emplace_back("__F18", "1"); + options.predefinitions.emplace_back("__F18_MAJOR__", "1"); + options.predefinitions.emplace_back("__F18_MINOR__", "1"); + options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); +#if __x86_64__ + options.predefinitions.emplace_back("__x86_64__", "1"); +#endif + + Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; + Fortran::parser::AllSources allSources; + Fortran::semantics::SemanticsContext semanticsContext{ + defaultKinds, options.features, allSources}; + semanticsContext.set_moduleDirectory(moduleDir) + .set_moduleFileSuffix(moduleSuffix) + .set_searchDirectories(includeDirs) + .set_warnOnNonstandardUsage(warnStdViolation) + .set_warningsAreErrors(warnIsError); + + convertFortranSourceToMLIR(inputFilename, options, programPrefix, + semanticsContext, passPipe); + return exitStatus; +}