diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h --- a/flang/include/flang/Lower/ConvertVariable.h +++ b/flang/include/flang/Lower/ConvertVariable.h @@ -44,6 +44,12 @@ void instantiateVariable(AbstractConverter &, const pft::Variable &var, SymMap &symMap, AggregateStoreMap &storeMap); +/// Create a fir::GlobalOp given a module variable definition. This is intended +/// to be used when lowering a module definition, not when lowering variables +/// used from a module. For used variables instantiateVariable must directly be +/// called. +void defineModuleVariable(AbstractConverter &, const pft::Variable &var); + /// Lower a symbol attributes given an optional storage \p and add it to the /// provided symbol map. If \preAlloc is not provided, a temporary storage will /// be allocated. This is a low level function that should only be used if diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -28,6 +28,7 @@ #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Support/FIRContext.h" +#include "flang/Optimizer/Support/InternalNames.h" #include "flang/Runtime/iostat.h" #include "flang/Semantics/tools.h" #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h" @@ -57,24 +58,70 @@ /// Convert the PFT to FIR. void run(Fortran::lower::pft::Program &pft) { + // Primary translation pass. + // - Declare all functions that have definitions so that definition + // signatures prevail over call site signatures. + // - Define module variables and OpenMP/OpenACC declarative construct so + // that they are available before lowering any function that may use + // them. + for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) { + std::visit(Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { + declareFunction(f); + }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) { + lowerModuleDeclScope(m); + for (Fortran::lower::pft::FunctionLikeUnit &f : + m.nestedFunctions) + declareFunction(f); + }, + [&](Fortran::lower::pft::BlockDataUnit &b) {}, + [&](Fortran::lower::pft::CompilerDirectiveUnit &d) { + setCurrentPosition( + d.get().source); + mlir::emitWarning(toLocation(), + "ignoring all compiler directives"); + }, + }, + u); + } + // 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::ModuleLikeUnit &m) { lowerMod(m); }, [&](Fortran::lower::pft::BlockDataUnit &b) {}, - [&](Fortran::lower::pft::CompilerDirectiveUnit &d) { - setCurrentPosition( - d.get().source); - mlir::emitWarning(toLocation(), - "ignoring all compiler directives"); - }, + [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {}, }, u); } } + /// Declare a function. + void declareFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + setCurrentPosition(funit.getStartingSourceLoc()); + for (int entryIndex = 0, last = funit.entryPointList.size(); + entryIndex < last; ++entryIndex) { + funit.setActiveEntry(entryIndex); + // Calling CalleeInterface ctor will build a declaration mlir::FuncOp with + // no other side effects. + // TODO: when doing some compiler profiling on real apps, it may be worth + // to check it's better to save the CalleeInterface instead of recomputing + // it later when lowering the body. CalleeInterface ctor should be linear + // with the number of arguments, so it is not awful to do it that way for + // now, but the linear coefficient might be non negligible. Until + // measured, stick to the solution that impacts the code less. + Fortran::lower::CalleeInterface{funit, *this}; + } + funit.setActiveEntry(0); + + // Declare internal procedures + for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions) + declareFunction(f); + } + //===--------------------------------------------------------------------===// // AbstractConverter overrides //===--------------------------------------------------------------------===// @@ -407,6 +454,41 @@ lowerFunc(f); // internal procedure } + /// Lower module variable definitions to fir::globalOp and OpenMP/OpenACC + /// declarative construct. + void lowerModuleDeclScope(Fortran::lower::pft::ModuleLikeUnit &mod) { + // FIXME: get rid of the bogus function context and instantiate the + // globals directly into the module. + MLIRContext *context = &getMLIRContext(); + setCurrentPosition(mod.getStartingSourceLoc()); + mlir::FuncOp func = fir::FirOpBuilder::createFunction( + mlir::UnknownLoc::get(context), getModuleOp(), + fir::NameUniquer::doGenerated("ModuleSham"), + mlir::FunctionType::get(context, llvm::None, llvm::None)); + func.addEntryBlock(); + builder = new fir::FirOpBuilder(func, bridge.getKindMap()); + for (const Fortran::lower::pft::Variable &var : + mod.getOrderedSymbolTable()) { + // Only define the variables owned by this module. + const Fortran::semantics::Scope *owningScope = var.getOwningScope(); + if (!owningScope || mod.getScope() == *owningScope) + Fortran::lower::defineModuleVariable(*this, var); + } + for (auto &eval : mod.evaluationList) + genFIR(eval); + if (mlir::Region *region = func.getCallableRegion()) + region->dropAllReferences(); + func.erase(); + delete builder; + builder = nullptr; + } + + /// Lower functions contained in a module. + void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) { + for (Fortran::lower::pft::FunctionLikeUnit &f : mod.nestedFunctions) + lowerFunc(f); + } + mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; } private: diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1005,6 +1005,31 @@ }); } +void Fortran::lower::defineModuleVariable( + AbstractConverter &converter, const Fortran::lower::pft::Variable &var) { + // Use empty linkage for module variables, which makes them available + // for use in another unit. + mlir::StringAttr externalLinkage; + if (!var.isGlobal()) + fir::emitFatalError(converter.getCurrentLocation(), + "attempting to lower module variable as local"); + // Define aggregate storages for equivalenced objects. + if (var.isAggregateStore()) { + const mlir::Location loc = converter.genLocation(var.getSymbol().name()); + TODO(loc, "defineModuleVariable aggregateStore"); + } + const Fortran::semantics::Symbol &sym = var.getSymbol(); + if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) { + const mlir::Location loc = converter.genLocation(sym.name()); + TODO(loc, "defineModuleVariable common block"); + } else if (var.isAlias()) { + // Do nothing. Mapping will be done on user side. + } else { + std::string globalName = Fortran::lower::mangle::mangleName(sym); + defineGlobal(converter, var, globalName, externalLinkage); + } +} + void Fortran::lower::instantiateVariable(AbstractConverter &converter, const pft::Variable &var, SymMap &symMap, diff --git a/flang/test/Lower/allocatable-assignment.f90 b/flang/test/Lower/allocatable-assignment.f90 --- a/flang/test/Lower/allocatable-assignment.f90 +++ b/flang/test/Lower/allocatable-assignment.f90 @@ -1,11 +1,14 @@ ! Test allocatable assignments ! RUN: bbc -emit-fir %s -o - | FileCheck %s +module alloc_assign +contains + ! ----------------------------------------------------------------------------- ! Test simple scalar RHS ! ----------------------------------------------------------------------------- -! CHECK-LABEL: func @_QPtest_simple_scalar( +! CHECK-LABEL: func @_QMalloc_assignPtest_simple_scalar( ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}) { subroutine test_simple_scalar(x) real, allocatable :: x @@ -40,10 +43,10 @@ x = 42. end subroutine -! CHECK-LABEL: func @_QPtest_simple_local_scalar() { +! CHECK-LABEL: func @_QMalloc_assignPtest_simple_local_scalar() { subroutine test_simple_local_scalar() real, allocatable :: x -! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.heap {uniq_name = "_QFtest_simple_local_scalarEx.addr"} +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.heap {uniq_name = "_QMalloc_assignFtest_simple_local_scalarEx.addr"} ! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.heap ! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> ! CHECK: %[[VAL_3:.*]] = arith.constant 4.200000e+01 : f32 @@ -74,3 +77,5 @@ ! CHECK: } x = 42. end subroutine + +end module