[llvm-branch-commits] [flang] 6986167 - [flang] Submodules
V Donaldson via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Mon Dec 5 13:52:09 PST 2022
Author: V Donaldson
Date: 2022-12-05T13:46:36-08:00
New Revision: 6986167ea3116fce7281a6ce1c1be88ef9b0be27
URL: https://github.com/llvm/llvm-project/commit/6986167ea3116fce7281a6ce1c1be88ef9b0be27
DIFF: https://github.com/llvm/llvm-project/commit/6986167ea3116fce7281a6ce1c1be88ef9b0be27.diff
LOG: [flang] Submodules
A submodule is a program unit that may contain the implementions of procedures
declared in a parent module or an intermediate ancestor submodule.
Processing for the equivalence groups and variables declared in a submodule
scope is similar to existing processing for the equivalence groups and
variables in module and procedure scopes. However, module and procedure scopes
are tied directly to code in the Pre-FIR Tree (PFT), whereas processing for a
submodule must have access to a module scope that, while guaranteed to be
present in a .mod file, is not guaranteed to be in the PFT. This difference
is accommodated by tying all scope processing to a front end scope, independent
of the PFT. Function scopes that can be processed on the fly are done that way;
the resulting variable information is never stored. Module and submodule scopes
whose symbol information may be needed during lowering of any number of module
procedures are instead cached on first use, and reused as needed.
These changes are a direct extension of current code. All module and submodule
variables in scope are processed, whether referenced or not. A possible
alternative would be to instead process symbols only when first used. While
this could ultimately be beneficial, such an approach must account for the
presence of equivalence groups. That information is not currently available
for on-the-fly variable processing.
Some additional changes are needed to include submodules in places where
modules must be considered, and to include separate module procedures in
places where other subprogram variants are considered. There are also some
incidental bug fixes, such as for variables in equivalence groups used in
namelist groups, which have a loose association with scope processing code.
Added:
flang/test/Lower/submodule.f90
Modified:
flang/include/flang/Lower/ConvertVariable.h
flang/include/flang/Lower/PFTBuilder.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/IO.cpp
flang/lib/Lower/Mangler.cpp
flang/lib/Lower/PFTBuilder.cpp
flang/test/Lower/pre-fir-tree01.f90
flang/test/Lower/pre-fir-tree02.f90
flang/test/Lower/pre-fir-tree06.f90
flang/test/Lower/pre-fir-tree07.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index a715d546e682a..ee8ef168a07d0 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -50,6 +50,11 @@ using AggregateStoreMap = llvm::DenseMap<AggregateStoreKey, mlir::Value>;
void instantiateVariable(AbstractConverter &, const pft::Variable &var,
SymMap &symMap, AggregateStoreMap &storeMap);
+/// Return the compiler-generated name of a static namelist variable descriptor.
+std::string
+globalNamelistDescriptorName(Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym);
+
/// 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
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 933d50a0c015b..be3f9f3b10593 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -37,7 +37,6 @@ struct ModuleLikeUnit;
struct FunctionLikeUnit;
using EvaluationList = std::list<Evaluation>;
-using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
/// Provide a variant like container that can hold references. It can hold
/// constant or mutable references. It is used in the other classes to provide
@@ -445,7 +444,7 @@ struct Variable {
const semantics::Symbol *namingSymbol;
/// Compiler generated symbol with the aggregate initial value if any.
const semantics::Symbol *initialValueSymbol = nullptr;
- /// Is this a global aggregate ?
+ /// Is this a global aggregate?
bool isGlobalAggregate;
};
@@ -485,10 +484,10 @@ struct Variable {
return std::visit([](const auto &x) { return x.isGlobal(); }, var);
}
- /// Is this a module variable ?
- bool isModuleVariable() const {
+ /// Is this a module or submodule variable?
+ bool isModuleOrSubmodule() const {
const semantics::Scope *scope = getOwningScope();
- return scope && scope->IsModule();
+ return scope && scope->kind() == Fortran::semantics::Scope::Kind::Module;
}
const Fortran::semantics::Scope *getOwningScope() const {
@@ -522,7 +521,7 @@ struct Variable {
return s->aliaser;
return false;
}
- std::size_t getAlias() const {
+ std::size_t getAliasOffset() const {
if (auto *s = std::get_if<Nominal>(&var))
return s->aliasOffset;
return 0;
@@ -568,6 +567,25 @@ struct Variable {
std::variant<Nominal, AggregateStore> var;
};
+using VariableList = std::vector<Variable>;
+using ScopeVariableListMap =
+ std::map<const Fortran::semantics::Scope *, VariableList>;
+
+/// Find or create a list of the equivalence sets and variables that appear
+/// in \p scope. The result is cached. Used for module and submodule scopes.
+VariableList *getCachedVariableList(const Fortran::semantics::Scope *scope,
+ lower::pft::Program &root);
+
+/// Create a list of the equivalence sets and variables that appear in \p scope.
+/// The result is not cached. Used for program, subprogram, and block scopes.
+VariableList getVariableList(const Fortran::semantics::Scope *scope);
+
+/// Create a list of the equivalence sets and variables that appear in the
+/// specification expressions of a function result. The result is not cached.
+VariableList buildFuncResultDependencyList(const Fortran::semantics::Symbol &);
+
+void dump(VariableList &, std::string s = {}); // `s` is an optional label
+
/// Function-like units may contain evaluations (executable statements) and
/// nested function-like units (internal procedures and function statements).
struct FunctionLikeUnit : public ProgramUnit {
@@ -597,8 +615,6 @@ struct FunctionLikeUnit : public ProgramUnit {
FunctionLikeUnit(FunctionLikeUnit &&) = default;
FunctionLikeUnit(const FunctionLikeUnit &) = delete;
- std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
-
bool isMainProgram() const {
return endStmt.isA<parser::Statement<parser::EndProgramStmt>>();
}
@@ -652,9 +668,13 @@ struct FunctionLikeUnit : public ProgramUnit {
LLVM_DUMP_METHOD void dump() const;
- /// Anonymous programs do not have a begin statement
+ /// Get the function scope.
+ const Fortran::semantics::Scope &getScope() const { return *scope; }
+
+ /// Anonymous programs do not have a begin statement.
std::optional<FunctionStatement> beginStmt;
FunctionStatement endStmt;
+ const semantics::Scope *scope;
EvaluationList evaluationList;
LabelEvalMap labelEvaluationMap;
SymbolLabelMap assignSymbolLabelMap;
@@ -673,7 +693,6 @@ struct FunctionLikeUnit : public ProgramUnit {
const semantics::Symbol *primaryResult{nullptr};
/// Terminal basic block (if any)
mlir::Block *finalBlock{};
- std::vector<std::vector<Variable>> varList;
HostAssociations hostAssociations;
};
@@ -694,8 +713,6 @@ struct ModuleLikeUnit : public ProgramUnit {
LLVM_DUMP_METHOD void dump() const;
- std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
-
/// Get the starting source location for this module like unit.
parser::CharBlock getStartingSourceLoc() const;
@@ -706,7 +723,6 @@ struct ModuleLikeUnit : public ProgramUnit {
ModuleStatement endStmt;
std::list<FunctionLikeUnit> nestedFunctions;
EvaluationList evaluationList;
- std::vector<std::vector<Variable>> varList;
};
/// Block data units contain the variables and data initializers for common
@@ -746,6 +762,9 @@ struct Program {
const semantics::CommonBlockList &getCommonBlocks() const {
return commonBlocks;
}
+ ScopeVariableListMap &getModuleScopeVariableListMap() {
+ return moduleScopeVariableListMap;
+ }
/// LLVM dump method on a Program.
LLVM_DUMP_METHOD void dump() const;
@@ -753,13 +772,9 @@ struct Program {
private:
std::list<Units> units;
semantics::CommonBlockList commonBlocks;
+ ScopeVariableListMap moduleScopeVariableListMap;
};
-/// Return the list of variables that appears in the specification expressions
-/// of a function result.
-std::vector<pft::Variable>
-buildFuncResultDependencyList(const Fortran::semantics::Symbol &);
-
/// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end
/// statements.
template <typename T>
@@ -777,6 +792,12 @@ ParentType *getAncestor(A &node) {
[](auto &p) -> ParentType * { return getAncestor<ParentType>(p); }});
}
+/// Get the root PFT Program node. (Provides access to "global" pft data.)
+template <typename A>
+Program *getPftRoot(A &node) {
+ return getAncestor<Program>(node);
+}
+
/// Call the provided \p callBack on all symbols that are referenced inside \p
/// funit.
void visitAllSymbols(const FunctionLikeUnit &funit,
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 8913cb8aff7e8..f44671c5f7af4 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3077,10 +3077,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void genFIR(const Fortran::parser::SelectTypeStmt &) {} // nop
void genFIR(const Fortran::parser::TypeGuardStmt &) {} // nop
- void genFIR(const Fortran::parser::NamelistStmt &) {
- TODO(toLocation(), "NamelistStmt lowering");
- }
-
/// Generate FIR for the Evaluation `eval`.
void genFIR(Fortran::lower::pft::Evaluation &eval,
bool unstructuredContext = true) {
@@ -3202,9 +3198,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::genThreadprivateOp(*this, var);
}
- /// Prepare to translate a new function
+ /// Start translation of a function.
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
assert(!builder && "expected nullptr");
+ const Fortran::semantics::Scope *scope = &funit.getScope();
+ LLVM_DEBUG(llvm::dbgs() << "\n[bridge - startNewFunction]";
+ if (auto *sym = scope->symbol()) llvm::dbgs() << " " << *sym;
+ llvm::dbgs() << "\n");
Fortran::lower::CalleeInterface callee(funit, *this);
mlir::func::FuncOp func = callee.addEntryBlockAndMapArguments();
builder = new fir::FirOpBuilder(func, bridge.getKindMap());
@@ -3215,33 +3215,35 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mapDummiesAndResults(funit, callee);
- // Note: not storing Variable references because getOrderedSymbolTable
- // below returns a temporary.
+ // Non-primary results of a function with multiple entry points.
+ // These result values share storage with the primary result.
llvm::SmallVector<Fortran::lower::pft::Variable> deferredFuncResultList;
- // Backup actual argument for entry character results
- // with
diff erent lengths. It needs to be added to the non
- // primary results symbol before mapSymbolAttributes is called.
+ // Backup actual argument for entry character results with
diff erent
+ // lengths. It needs to be added to the non-primary results symbol before
+ // mapSymbolAttributes is called.
Fortran::lower::SymbolBox resultArg;
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
passedResult = callee.getPassedResult())
resultArg = lookupSymbol(passedResult->entity->get());
Fortran::lower::AggregateStoreMap storeMap;
- // The front-end is currently not adding module variables referenced
- // in a module procedure as host associated. As a result we need to
- // instantiate all module variables here if this is a module procedure.
- // It is likely that the front-end behavior should change here.
- // This also applies to internal procedures inside module procedures.
- if (auto *module = Fortran::lower::pft::getAncestor<
- Fortran::lower::pft::ModuleLikeUnit>(funit))
- for (const Fortran::lower::pft::Variable &var :
- module->getOrderedSymbolTable())
- instantiateVar(var, storeMap);
+ // Map all containing submodule and module equivalences and variables, in
+ // case they are referenced. It might be better to limit this to variables
+ // that are actually referenced, although that is more complicated for
+ // equivalenced variables.
+ Fortran::lower::pft::Program &root = *getPftRoot(funit);
+ for (auto *scp = &scope->parent(); !scp->IsGlobal(); scp = &scp->parent())
+ if (scp->kind() == Fortran::semantics::Scope::Kind::Module)
+ for (const Fortran::lower::pft::Variable &var :
+ *Fortran::lower::pft::getCachedVariableList(scp, root))
+ instantiateVar(var, storeMap);
+
+ // Map function equivalences and variables.
mlir::Value primaryFuncResultStorage;
for (const Fortran::lower::pft::Variable &var :
- funit.getOrderedSymbolTable()) {
+ Fortran::lower::pft::getVariableList(scope)) {
// Always instantiate aggregate storage blocks.
if (var.isAggregateStore()) {
instantiateVar(var, storeMap);
@@ -3249,9 +3251,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
const Fortran::semantics::Symbol &sym = var.getSymbol();
if (funit.parentHasHostAssoc()) {
- // Never instantitate host associated variables, as they are already
- // instantiated from an argument tuple. Instead, just bind the symbol to
- // the reference to the host variable, which must be in the map.
+ // Never instantiate host associated variables, as they are already
+ // instantiated from an argument tuple. Instead, just bind the symbol
+ // to the host variable, which must be in the map.
const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
if (funit.parentHostAssoc().isAssociated(ultimate)) {
Fortran::lower::SymbolBox hostBox = lookupSymbol(ultimate);
@@ -3377,7 +3379,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
startBlock(newBlock);
}
- /// Emit return and cleanup after the function has been translated.
+ /// Finish translation of a function.
void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
if (funit.isMainProgram())
@@ -3385,12 +3387,15 @@ class FirConverter : public Fortran::lower::AbstractConverter {
else
genFIRProcedureExit(funit, funit.getSubprogramSymbol());
funit.finalBlock = nullptr;
- LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
+ LLVM_DEBUG(llvm::dbgs() << "\n[bridge - endNewFunction";
+ if (auto *sym = funit.scope->symbol()) llvm::dbgs()
+ << " " << sym->name();
+ llvm::dbgs() << "] generated IR:\n\n"
<< *builder->getFunction() << '\n');
- // FIXME: Simplification should happen in a normal pass, not here.
+ // Eliminate dead code as a prerequisite to calling other IR passes.
+ // FIXME: This simplification should happen in a normal pass, not here.
mlir::IRRewriter rewriter(*builder);
- (void)mlir::simplifyRegions(rewriter,
- {builder->getRegion()}); // remove dead code
+ (void)mlir::simplifyRegions(rewriter, {builder->getRegion()});
delete builder;
builder = nullptr;
hostAssocTuple = mlir::Value{};
@@ -3444,14 +3449,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// Lower a procedure (nest).
void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
- if (!funit.isMainProgram()) {
- const Fortran::semantics::Symbol &procSymbol =
- funit.getSubprogramSymbol();
- if (procSymbol.owner().IsSubmodule())
- TODO(toLocation(), "support for submodules");
- if (Fortran::semantics::IsSeparateModuleProcedureInterface(&procSymbol))
- TODO(toLocation(), "separate module procedure");
- }
setCurrentPosition(funit.getStartingSourceLoc());
for (int entryIndex = 0, last = funit.entryPointList.size();
entryIndex < last; ++entryIndex) {
@@ -3472,7 +3469,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
setCurrentPosition(mod.getStartingSourceLoc());
createGlobalOutsideOfFunctionLowering([&]() {
for (const Fortran::lower::pft::Variable &var :
- mod.getOrderedSymbolTable()) {
+ *Fortran::lower::pft::getCachedVariableList(&mod.getScope(),
+ *getPftRoot(mod))) {
// Only define the variables owned by this module.
const Fortran::semantics::Scope *owningScope = var.getOwningScope();
if (!owningScope || mod.getScope() == *owningScope)
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index f734b7a0a0b8b..7494d882e838e 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -538,7 +538,7 @@ getLinkageAttribute(fir::FirOpBuilder &builder,
// with `linkonce_odr` LLVM linkage.
if (var.hasSymbol() && isRuntimeTypeInfoData(var.getSymbol()))
return builder.createLinkOnceODRLinkage();
- if (var.isModuleVariable())
+ if (var.isModuleOrSubmodule())
return {}; // external linkage
// Otherwise, the variable is owned by a procedure and must not be visible in
// other compilation units.
@@ -558,7 +558,7 @@ static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
mlir::Location loc = genLocation(converter, sym);
fir::GlobalOp global = builder.getNamedGlobal(globalName);
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
- if (var.isModuleVariable()) {
+ if (var.isModuleOrSubmodule()) {
// A module global was or will be defined when lowering the module. Emit
// only a declaration if the global does not exist at that point.
global = declareGlobal(converter, var, globalName, linkage);
@@ -713,7 +713,7 @@ static mlir::Value
getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
const Fortran::lower::pft::Variable &alias) {
Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
- alias.getAlias()};
+ alias.getAliasOffset()};
auto iter = storeMap.find(key);
assert(iter != storeMap.end());
return iter->second;
@@ -819,7 +819,7 @@ instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
fir::GlobalOp global;
auto &aggregate = var.getAggregateStore();
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
- if (var.isModuleVariable()) {
+ if (var.isModuleOrSubmodule()) {
// A module global was or will be defined when lowering the module. Emit
// only a declaration if the global does not exist at that point.
global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,
@@ -871,18 +871,17 @@ static void instantiateAlias(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym = var.getSymbol();
const mlir::Location loc = genLocation(converter, sym);
mlir::IndexType idxTy = builder.getIndexType();
- std::size_t aliasOffset = var.getAlias();
- mlir::Value store = getAggregateStore(storeMap, var);
+ mlir::Type symType = converter.genType(sym);
mlir::IntegerType i8Ty = builder.getIntegerType(8);
mlir::Type i8Ptr = builder.getRefType(i8Ty);
- mlir::Value offset = builder.createIntegerConstant(
- loc, idxTy, sym.GetUltimate().offset() - aliasOffset);
- auto ptr = builder.create<fir::CoordinateOp>(loc, i8Ptr, store,
- mlir::ValueRange{offset});
- mlir::Value preAlloc =
- castAliasToPointer(builder, loc, converter.genType(sym), ptr);
+ std::size_t off = sym.GetUltimate().offset() - var.getAliasOffset();
+ mlir::Value storeAddr = getAggregateStore(storeMap, var);
+ mlir::Value offset = builder.createIntegerConstant(loc, idxTy, off);
+ mlir::Value bytePtr = builder.create<fir::CoordinateOp>(
+ loc, i8Ptr, storeAddr, mlir::ValueRange{offset});
+ mlir::Value typedPtr = castAliasToPointer(builder, loc, symType, bytePtr);
Fortran::lower::StatementContext stmtCtx;
- mapSymbolAttributes(converter, var, symMap, stmtCtx, preAlloc);
+ mapSymbolAttributes(converter, var, symMap, stmtCtx, typedPtr);
// Default initialization is possible for equivalence members: see
// F2018 19.5.3.4. Note that if several equivalenced entities have
// default initialization, they must have the same type, and the standard
@@ -892,6 +891,45 @@ static void instantiateAlias(Fortran::lower::AbstractConverter &converter,
// the equivalenced storages. Keep lowering simple.
if (mustBeDefaultInitializedAtRuntime(var))
defaultInitializeAtRuntime(converter, var, symMap);
+
+ // A global variable in a namelist group needs a static descriptor.
+ if (var.isGlobal() &&
+ sym.test(Fortran::semantics::Symbol::Flag::InNamelist) &&
+ !IsAllocatableOrPointer(sym)) {
+ std::string mangleName = globalNamelistDescriptorName(converter, sym);
+ if (builder.getNamedGlobal(mangleName))
+ return;
+ // Clone the instantiation sequence above in a fir.global definition for
+ // use as the base address of the descriptor.
+ auto descFunc = [&](fir::FirOpBuilder &b) {
+ mlir::Operation *op = storeAddr.getDefiningOp();
+ mlir::SymbolRefAttr base;
+ mlir::Value newStoreAddr;
+ if (mlir::isa<fir::AddrOfOp>(op)) {
+ // storeAddr is an AddrOfOp instruction.
+ base = mlir::dyn_cast<fir::AddrOfOp>(op).getSymbol();
+ newStoreAddr = b.create<fir::AddrOfOp>(loc, storeAddr.getType(), base);
+ } else {
+ // storeAddr is an {AddrOfOp,ConvertOp} sequence.
+ assert(mlir::isa<fir::ConvertOp>(op));
+ mlir::Value tmpAddr = op->getOperand(0);
+ mlir::Operation *op1 = tmpAddr.getDefiningOp();
+ assert(mlir::isa<fir::AddrOfOp>(op1));
+ base = mlir::dyn_cast<fir::AddrOfOp>(op1).getSymbol();
+ newStoreAddr = b.create<fir::AddrOfOp>(loc, tmpAddr.getType(), base);
+ newStoreAddr = b.createConvert(loc, storeAddr.getType(), newStoreAddr);
+ }
+ offset = b.createIntegerConstant(loc, idxTy, off);
+ bytePtr = b.create<fir::CoordinateOp>(loc, i8Ptr, newStoreAddr,
+ mlir::ValueRange{offset});
+ typedPtr = castAliasToPointer(b, loc, symType, bytePtr);
+ mlir::Value box = b.createBox(loc, typedPtr);
+ b.create<fir::HasValueOp>(loc, box);
+ };
+ mlir::StringAttr linkOnce = builder.createLinkOnceLinkage();
+ fir::BoxType boxTy = fir::BoxType::get(fir::PointerType::get(symType));
+ builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce);
+ }
}
//===--------------------------------------------------------------===//
@@ -1814,19 +1852,26 @@ void Fortran::lower::instantiateVariable(AbstractConverter &converter,
if (!IsDummy(sym) && !IsFunctionResult(sym) && symMap.lookupSymbol(sym))
return;
}
- if (var.isAggregateStore()) {
+ LLVM_DEBUG(llvm::dbgs() << "instantiateVariable: "; var.dump());
+ if (var.isAggregateStore())
instantiateAggregateStore(converter, var, storeMap);
- } else if (const Fortran::semantics::Symbol *common =
- Fortran::semantics::FindCommonBlockContaining(
- var.getSymbol().GetUltimate())) {
+ else if (const Fortran::semantics::Symbol *common =
+ Fortran::semantics::FindCommonBlockContaining(
+ var.getSymbol().GetUltimate()))
instantiateCommon(converter, *common, var, symMap);
- } else if (var.isAlias()) {
+ else if (var.isAlias())
instantiateAlias(converter, var, symMap, storeMap);
- } else if (var.isGlobal()) {
+ else if (var.isGlobal())
instantiateGlobal(converter, var, symMap);
- } else {
+ else
instantiateLocal(converter, var, symMap);
- }
+}
+
+std::string Fortran::lower::globalNamelistDescriptorName(
+ Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym) {
+ std::string name = converter.mangleName(sym);
+ return IsAllocatableOrPointer(sym) ? name : name + ".desc"s;
}
void Fortran::lower::mapCallInterfaceSymbols(
@@ -1842,7 +1887,7 @@ void Fortran::lower::mapCallInterfaceSymbols(
const Fortran::semantics::Symbol &sym = var.getSymbol();
const auto *hostDetails =
sym.detailsIf<Fortran::semantics::HostAssocDetails>();
- if (hostDetails && !var.isModuleVariable()) {
+ if (hostDetails && !var.isModuleOrSubmodule()) {
// The callee is an internal procedure `A` whose result properties
// depend on host variables. The caller may be the host, or another
// internal procedure `B` contained in the same host. In the first
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 1e4bd7e0227de..b5d65ca0b134f 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -269,7 +269,7 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
symbol.name().ToString() + '\0');
};
- // Define object names, and static descriptors for global objects.
+ // Define variable names, and static descriptors for global variables.
bool groupIsLocal = false;
stringAddress(symbol);
for (const Fortran::semantics::Symbol &s : details.objects()) {
@@ -278,10 +278,11 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
groupIsLocal = true;
continue;
}
- // We know we have a global item. It it's not a pointer or allocatable,
- // create a static pointer to it.
+ // A global pointer or allocatable variable has a descriptor for typical
+ // accesses. Equivalence variables and variables in multiple namelist
+ // groups may already have one. Create descriptors for other cases here.
if (!IsAllocatableOrPointer(s)) {
- std::string mangleName = converter.mangleName(s) + ".desc";
+ std::string mangleName = globalNamelistDescriptorName(converter, s);
if (builder.getNamedGlobal(mangleName))
continue;
const auto expr = Fortran::evaluate::AsGenericExpr(s);
@@ -316,10 +317,8 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
builder.getArrayAttr(idx));
idx[1] = one;
mlir::Value descAddr;
- // Items that we created end in ".desc".
- std::string suffix = IsAllocatableOrPointer(s) ? "" : ".desc";
- if (auto desc =
- builder.getNamedGlobal(converter.mangleName(s) + suffix)) {
+ if (auto desc = builder.getNamedGlobal(
+ globalNamelistDescriptorName(converter, s))) {
descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(),
desc.getSymbol());
} else if (Fortran::semantics::FindCommonBlockContaining(s) &&
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index f284a55dbc782..757bafc04f7f0 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -55,21 +55,6 @@ hostName(const Fortran::semantics::Symbol &symbol) {
return {};
}
-static const Fortran::semantics::Symbol *
-findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
- const Fortran::semantics::Scope &scope = symbol.owner();
- if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
- scope.IsSubmodule()) {
- // FIXME symbol from MpSubprogramStmt do not seem to have
- // Attr::MODULE set.
- const Fortran::semantics::Symbol *iface =
- scope.parent().FindSymbol(symbol.name());
- assert(iface && "Separate module procedure must be declared");
- return iface;
- }
- return nullptr;
-}
-
// Mangle the name of `symbol` to make it unique within FIR's symbol table using
// the FIR name mangler, `mangler`
std::string
@@ -100,18 +85,19 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
[&](const Fortran::semantics::MainProgramDetails &) {
return fir::NameUniquer::doProgramEntry().str();
},
- [&](const Fortran::semantics::SubprogramDetails &) {
+ [&](const Fortran::semantics::SubprogramDetails &subpDetails) {
// Mangle external procedure without any scope prefix.
if (!keepExternalInScope &&
Fortran::semantics::IsExternal(ultimateSymbol))
return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
symbolName);
- // Separate module subprograms must be mangled according to the
- // scope where they were declared (the symbol we have is the
- // definition).
+ // A separate module procedure must be mangled according to its
+ // declaration scope, not its definition scope.
const Fortran::semantics::Symbol *interface = &ultimateSymbol;
- if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
- interface = mpIface;
+ if (interface->attrs().test(Fortran::semantics::Attr::MODULE) &&
+ interface->owner().IsSubmodule() && !subpDetails.isInterface())
+ interface = subpDetails.moduleInterface();
+ assert(interface && "Separate module procedure must be declared");
llvm::SmallVector<llvm::StringRef> modNames =
moduleNames(*interface);
return fir::NameUniquer::doProcedure(modNames, hostName(*interface),
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 19b2512dc9224..ff177d7e69f45 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -64,6 +64,8 @@ struct UnwrapStmt<parser::UnlabeledStatement<A>> {
std::optional<parser::Label> label;
};
+void dumpScope(const semantics::Scope *scope, int depth = -1);
+
/// The instantiation of a parse tree visitor (Pre and Post) is extremely
/// expensive in terms of compile and link time. So one goal here is to
/// limit the bridge to one such instantiation.
@@ -215,12 +217,13 @@ class PFTBuilder {
private:
/// Initialize a new module-like unit and make it the builder's focus.
template <typename A>
- bool enterModule(const A &func) {
+ bool enterModule(const A &mod) {
Fortran::lower::pft::ModuleLikeUnit &unit =
- addUnit(lower::pft::ModuleLikeUnit{func, pftParentStack.back()});
+ addUnit(lower::pft::ModuleLikeUnit{mod, pftParentStack.back()});
functionList = &unit.nestedFunctions;
pushEvaluationList(&unit.evaluationList);
pftParentStack.emplace_back(unit);
+ LLVM_DEBUG(dumpScope(&unit.getScope()));
return true;
}
@@ -290,6 +293,7 @@ class PFTBuilder {
functionList = &unit.nestedFunctions;
pushEvaluationList(&unit.evaluationList);
pftParentStack.emplace_back(unit);
+ LLVM_DEBUG(dumpScope(&unit.getScope()));
return true;
}
@@ -1033,6 +1037,45 @@ class PFTBuilder {
lower::pft::Evaluation *lastLexicalEvaluation{};
};
+/// Dump all program scopes and symbols with addresses to disambiguate names.
+/// This is static, unchanging front end information, so dump it only once.
+void dumpScope(const semantics::Scope *scope, int depth) {
+ static int initialVisitCounter = 0;
+ if (depth < 0) {
+ if (++initialVisitCounter != 1)
+ return;
+ while (!scope->IsGlobal())
+ scope = &scope->parent();
+ LLVM_DEBUG(llvm::dbgs() << "Full program scope information.\n"
+ "Addresses in angle brackets are scopes. "
+ "Unbracketed addresses are symbols.\n");
+ }
+ static const std::string white{" ++"};
+ std::string w = white.substr(0, depth * 2);
+ if (depth >= 0) {
+ LLVM_DEBUG(llvm::dbgs() << w << "<" << scope << "> ");
+ if (auto *sym{scope->symbol()}) {
+ LLVM_DEBUG(llvm::dbgs() << sym << " " << *sym << "\n");
+ } else {
+ if (scope->IsIntrinsicModules()) {
+ LLVM_DEBUG(llvm::dbgs() << "IntrinsicModules (no detail)\n");
+ return;
+ }
+ LLVM_DEBUG(llvm::dbgs() << "[anonymous]\n");
+ }
+ }
+ for (const auto &scp : scope->children())
+ if (!scp.symbol())
+ dumpScope(&scp, depth + 1);
+ for (auto iter = scope->begin(); iter != scope->end(); ++iter) {
+ common::Reference<semantics::Symbol> sym = iter->second;
+ if (auto scp = sym->scope())
+ dumpScope(scp, depth + 1);
+ else
+ LLVM_DEBUG(llvm::dbgs() << w + " " << &*sym << " " << *sym << "\n");
+ }
+}
+
class PFTDumper {
public:
void dumpPFT(llvm::raw_ostream &outputStream,
@@ -1162,13 +1205,31 @@ class PFTDumper {
void dumpModuleLikeUnit(llvm::raw_ostream &outputStream,
const lower::pft::ModuleLikeUnit &moduleLikeUnit) {
outputStream << getNodeIndex(moduleLikeUnit) << " ";
- outputStream << "ModuleLike:\n";
+ llvm::StringRef unitKind;
+ llvm::StringRef name;
+ llvm::StringRef header;
+ moduleLikeUnit.beginStmt.visit(common::visitors{
+ [&](const parser::Statement<parser::ModuleStmt> &stmt) {
+ unitKind = "Module";
+ name = toStringRef(stmt.statement.v.source);
+ header = toStringRef(stmt.source);
+ },
+ [&](const parser::Statement<parser::SubmoduleStmt> &stmt) {
+ unitKind = "Submodule";
+ name = toStringRef(std::get<parser::Name>(stmt.statement.t).source);
+ header = toStringRef(stmt.source);
+ },
+ [&](const auto &) {
+ llvm_unreachable("not a valid module begin stmt");
+ },
+ });
+ outputStream << unitKind << ' ' << name << ": " << header << '\n';
dumpEvaluationList(outputStream, moduleLikeUnit.evaluationList);
outputStream << "Contains\n";
for (const lower::pft::FunctionLikeUnit &func :
moduleLikeUnit.nestedFunctions)
dumpFunctionLikeUnit(outputStream, func);
- outputStream << "End Contains\nEnd ModuleLike\n\n";
+ outputStream << "End Contains\nEnd " << unitKind << ' ' << name << "\n\n";
}
// Top level directives
@@ -1277,55 +1338,42 @@ namespace {
/// depends upon. Otherwise this sort is stable and preserves the order of the
/// symbol table, which is sorted by name.
struct SymbolDependenceDepth {
- explicit SymbolDependenceDepth(
- std::vector<std::vector<lower::pft::Variable>> &vars)
- : vars{vars} {}
-
- void analyzeAliasesInCurrentScope(const semantics::Scope &scope) {
+ /// Analyze the equivalence sets of symbols defined in \p scope, plus the
+ /// equivalence sets in host module, submodule, and procedure scopes that
+ /// may define symbols referenced in \p scope. This analysis excludes
+ /// equivalence sets involving common blocks, which are handled elsewhere.
+ void analyzeEquivalenceSets(const semantics::Scope &scope) {
// FIXME: When this function is called on the scope of an internal
// procedure whose parent contains an EQUIVALENCE set and the internal
// procedure uses variables from that EQUIVALENCE set, we end up creating
// an AggregateStore for those variables unnecessarily.
- //
- /// If this is a function nested in a module no host associated
- /// symbol are added to the function scope for module symbols used in this
- /// scope. As a result, alias analysis in parent module scopes must be
- /// preformed here.
- const semantics::Scope *parentScope = &scope;
- while (!parentScope->IsGlobal()) {
- parentScope = &parentScope->parent();
- if (parentScope->IsModule())
- analyzeAliases(*parentScope);
- }
+
+ // A function defined in a sub/module has no explicit USE of its ancestor
+ // sub/modules. Analyze those scopes here in case there are references to
+ // symbols in them.
+ for (auto *scp = &scope.parent(); !scp->IsGlobal(); scp = &scp->parent())
+ if (scp->kind() == Fortran::semantics::Scope::Kind::Module)
+ analyzeLocalEquivalenceSets(*scp);
+ // Analyze local, USEd, and host procedure scope equivalences.
for (const auto &iter : scope) {
const semantics::Symbol &ultimate = iter.second.get().GetUltimate();
- if (skipSymbol(ultimate))
- continue;
- analyzeAliases(ultimate.owner());
+ if (!skipSymbol(ultimate))
+ analyzeLocalEquivalenceSets(ultimate.owner());
}
- // add all aggregate stores to the front of the work list
+ // Add all aggregate stores to the front of the variable list.
adjustSize(1);
// The copy in the loop matters, 'stores' will still be used.
for (auto st : stores)
- vars[0].emplace_back(std::move(st));
+ layeredVarList[0].emplace_back(std::move(st));
}
- // Compute the offset of the last byte that resides in the symbol.
- inline static std::size_t offsetWidth(const Fortran::semantics::Symbol &sym) {
- std::size_t width = sym.offset();
- if (std::size_t size = sym.size())
- width += size - 1;
- return width;
- }
-
- // Analyze the equivalence sets. This analysis need not be performed when the
- // scope has no equivalence sets.
- void analyzeAliases(const semantics::Scope &scope) {
+ /// Analyze the equivalence sets defined locally in \p scope that don't
+ /// involve common blocks.
+ void analyzeLocalEquivalenceSets(const semantics::Scope &scope) {
if (scope.equivalenceSets().empty())
- return;
- // Don't analyze a scope if it has already been analyzed.
+ return; // no equivalence sets to analyze
if (analyzedScopes.find(&scope) != analyzedScopes.end())
- return;
+ return; // equivalence sets already analyzed
analyzedScopes.insert(&scope);
std::list<std::list<semantics::SymbolRef>> aggregates =
@@ -1334,11 +1382,8 @@ struct SymbolDependenceDepth {
const Fortran::semantics::Symbol *aggregateSym = nullptr;
bool isGlobal = false;
const semantics::Symbol &first = *aggregate.front();
- // Skip aggregates related to common blocks as they will be handled by
- // instantiateCommon and the aggregate store information will not be used.
- // Additionally, the AggregateStoreKeys for common block related aggregate
- // stores can collide with non common block ones, potentially resulting in
- // incorrect stores being used.
+ // Exclude equivalence sets involving common blocks.
+ // Those are handled in instantiateCommon.
if (lower::definedInCommonBlock(first))
continue;
std::size_t start = first.offset();
@@ -1372,15 +1417,16 @@ struct SymbolDependenceDepth {
// other symbols.
int analyze(const semantics::Symbol &sym) {
auto done = seen.insert(&sym);
- LLVM_DEBUG(llvm::dbgs() << "analyze symbol: " << sym << '\n');
if (!done.second)
return 0;
+ LLVM_DEBUG(llvm::dbgs() << "analyze symbol " << &sym << " in <"
+ << &sym.owner() << ">: " << sym << '\n');
const bool isProcedurePointerOrDummy =
semantics::IsProcedurePointer(sym) ||
(semantics::IsProcedure(sym) && IsDummy(sym));
// A procedure argument in a subprogram with multiple entry points might
- // need a vars list entry to trigger creation of a symbol map entry in
- // some cases. Non-dummy procedures don't.
+ // need a layeredVarList entry to trigger creation of a symbol map entry
+ // in some cases. Non-dummy procedures don't.
if (semantics::IsProcedure(sym) && !isProcedurePointerOrDummy)
return 0;
semantics::Symbol ultimate = sym.GetUltimate();
@@ -1400,11 +1446,11 @@ struct SymbolDependenceDepth {
// Symbol must be something lowering will have to allocate.
int depth = 0;
- // Analyze symbols appearing in object entity specification expression. This
- // ensures these symbols will be instantiated before the current one.
+ // Analyze symbols appearing in object entity specification expressions.
+ // This ensures these symbols will be instantiated before the current one.
// This is not done for object entities that are host associated because
- // they must be instantiated from the value of the host symbols (the
- // specification expressions should not be re-evaluated).
+ // they must be instantiated from the value of the host symbols.
+ // (The specification expressions should not be re-evaluated.)
if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
const semantics::DeclTypeSpec *symTy = sym.GetType();
assert(symTy && "symbol must have a type");
@@ -1421,44 +1467,60 @@ struct SymbolDependenceDepth {
depth = std::max(analyze(s) + 1, depth);
}
};
- // handle any symbols in array bound declarations
+ // Handle any symbols in array bound declarations.
for (const semantics::ShapeSpec &subs : details->shape()) {
doExplicit(subs.lbound());
doExplicit(subs.ubound());
}
- // handle any symbols in coarray bound declarations
+ // Handle any symbols in coarray bound declarations.
for (const semantics::ShapeSpec &subs : details->coshape()) {
doExplicit(subs.lbound());
doExplicit(subs.ubound());
}
- // handle any symbols in initialization expressions
+ // Handle any symbols in initialization expressions.
if (auto e = details->init())
for (const auto &s : evaluate::CollectSymbols(*e))
depth = std::max(analyze(s) + 1, depth);
}
adjustSize(depth + 1);
bool global = lower::symbolIsGlobal(sym);
- vars[depth].emplace_back(sym, global, depth);
+ layeredVarList[depth].emplace_back(sym, global, depth);
if (semantics::IsAllocatable(sym))
- vars[depth].back().setHeapAlloc();
+ layeredVarList[depth].back().setHeapAlloc();
if (semantics::IsPointer(sym))
- vars[depth].back().setPointer();
+ layeredVarList[depth].back().setPointer();
if (ultimate.attrs().test(semantics::Attr::TARGET))
- vars[depth].back().setTarget();
+ layeredVarList[depth].back().setTarget();
// If there are alias sets, then link the participating variables to their
// aggregate stores when constructing the new variable on the list.
if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym))
- vars[depth].back().setAlias(store->getOffset());
+ layeredVarList[depth].back().setAlias(store->getOffset());
return depth;
}
- /// Save the final list of variable allocations as a single vector and free
- /// the rest.
- void finalize() {
- for (int i = 1, end = vars.size(); i < end; ++i)
- vars[0].insert(vars[0].end(), vars[i].begin(), vars[i].end());
- vars.resize(1);
+ /// Move the layered list of variables to the flat result list.
+ void finalize(lower::pft::VariableList &varList) {
+ for (int i = 0, end = layeredVarList.size(); i < end; ++i)
+ varList.insert(varList.end(), layeredVarList[i].begin(),
+ layeredVarList[i].end());
+ LLVM_DEBUG(Fortran::lower::pft::dump(varList, "finalize variableList"));
+ }
+
+private:
+ /// Skip symbol in alias analysis.
+ bool skipSymbol(const semantics::Symbol &sym) {
+ // Common block equivalences are largely managed by the front end.
+ // Compiler generated symbols ('.' names) cannot be equivalenced.
+ // FIXME: Equivalence code generation may need to be revisited.
+ return !sym.has<semantics::ObjectEntityDetails>() ||
+ lower::definedInCommonBlock(sym) || sym.name()[0] == '.';
+ }
+
+ // Make sure the table is of appropriate size.
+ void adjustSize(std::size_t size) {
+ if (layeredVarList.size() < size)
+ layeredVarList.resize(size);
}
Fortran::lower::pft::Variable::AggregateStore *
@@ -1499,24 +1561,8 @@ struct SymbolDependenceDepth {
return nullptr;
}
-private:
- /// Skip symbol in alias analysis.
- bool skipSymbol(const semantics::Symbol &sym) {
- // Common block equivalences are largely managed by the front end.
- // Compiler generated symbols ('.' names) cannot be equivalenced.
- // FIXME: Equivalence code generation may need to be revisited.
- return !sym.has<semantics::ObjectEntityDetails>() ||
- lower::definedInCommonBlock(sym) || sym.name()[0] == '.';
- }
-
- // Make sure the table is of appropriate size.
- void adjustSize(std::size_t size) {
- if (vars.size() < size)
- vars.resize(size);
- }
-
llvm::SmallSet<const semantics::Symbol *, 32> seen;
- std::vector<std::vector<lower::pft::Variable>> &vars;
+ std::vector<Fortran::lower::pft::VariableList> layeredVarList;
llvm::SmallSet<const semantics::Symbol *, 32> aliasSyms;
/// Set of Scope that have been analyzed for aliases.
llvm::SmallSet<const semantics::Scope *, 4> analyzedScopes;
@@ -1524,16 +1570,6 @@ struct SymbolDependenceDepth {
};
} // namespace
-static void processSymbolTable(
- const semantics::Scope &scope,
- std::vector<std::vector<Fortran::lower::pft::Variable>> &varList) {
- SymbolDependenceDepth sdd{varList};
- sdd.analyzeAliasesInCurrentScope(scope);
- for (const auto &iter : scope)
- sdd.analyze(iter.second.get());
- sdd.finalize();
-}
-
//===----------------------------------------------------------------------===//
// FunctionLikeUnit implementation
//===----------------------------------------------------------------------===//
@@ -1541,21 +1577,18 @@ static void processSymbolTable(
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
const parser::MainProgram &func, const lower::pft::PftNode &parent,
const semantics::SemanticsContext &semanticsContext)
- : ProgramUnit{func, parent}, endStmt{
- getFunctionStmt<parser::EndProgramStmt>(
- func)} {
+ : ProgramUnit{func, parent},
+ endStmt{getFunctionStmt<parser::EndProgramStmt>(func)} {
const auto &programStmt =
std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t);
if (programStmt.has_value()) {
beginStmt = FunctionStatement(programStmt.value());
const semantics::Symbol *symbol = getSymbol(*beginStmt);
entryPointList[0].first = symbol;
- processSymbolTable(*symbol->scope(), varList);
+ scope = symbol->scope();
} else {
- processSymbolTable(
- semanticsContext.FindScope(
- std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source),
- varList);
+ scope = &semanticsContext.FindScope(
+ std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source);
}
}
@@ -1567,7 +1600,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {
const semantics::Symbol *symbol = getSymbol(*beginStmt);
entryPointList[0].first = symbol;
- processSymbolTable(*symbol->scope(), varList);
+ scope = symbol->scope();
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
@@ -1578,7 +1611,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {
const semantics::Symbol *symbol = getSymbol(*beginStmt);
entryPointList[0].first = symbol;
- processSymbolTable(*symbol->scope(), varList);
+ scope = symbol->scope();
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
@@ -1589,7 +1622,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {
const semantics::Symbol *symbol = getSymbol(*beginStmt);
entryPointList[0].first = symbol;
- processSymbolTable(*symbol->scope(), varList);
+ scope = symbol->scope();
}
Fortran::lower::HostAssociations &
@@ -1621,19 +1654,13 @@ Fortran::lower::pft::FunctionLikeUnit::getStartingSourceLoc() const {
Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
const parser::Module &m, const lower::pft::PftNode &parent)
: ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
- endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {
- const semantics::Symbol *symbol = getSymbol(beginStmt);
- processSymbolTable(*symbol->scope(), varList);
-}
+ endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {}
Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
const parser::Submodule &m, const lower::pft::PftNode &parent)
- : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
- m)},
- endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {
- const semantics::Symbol *symbol = getSymbol(beginStmt);
- processSymbolTable(*symbol->scope(), varList);
-}
+ : ProgramUnit{m, parent},
+ beginStmt{getModuleStmt<parser::SubmoduleStmt>(m)},
+ endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
parser::CharBlock
Fortran::lower::pft::ModuleLikeUnit::getStartingSourceLoc() const {
@@ -1682,7 +1709,7 @@ void Fortran::lower::pft::Evaluation::dump() const {
void Fortran::lower::pft::Variable::dump() const {
if (auto *s = std::get_if<Nominal>(&var)) {
- llvm::errs() << "symbol: " << s->symbol->name();
+ llvm::errs() << s->symbol << " " << *s->symbol;
llvm::errs() << " (depth: " << s->depth << ')';
if (s->global)
llvm::errs() << ", global";
@@ -1708,6 +1735,16 @@ void Fortran::lower::pft::Variable::dump() const {
llvm::errs() << '\n';
}
+void Fortran::lower::pft::dump(Fortran::lower::pft::VariableList &variableList,
+ std::string s) {
+ llvm::errs() << (s.empty() ? "VariableList" : s) << " " << &variableList
+ << " size=" << variableList.size() << "\n";
+ for (auto var : variableList) {
+ llvm::errs() << " ";
+ var.dump();
+ }
+}
+
void Fortran::lower::pft::FunctionLikeUnit::dump() const {
PFTDumper{}.dumpFunctionLikeUnit(llvm::errs(), *this);
}
@@ -1721,21 +1758,60 @@ void Fortran::lower::pft::BlockDataUnit::dump() const {
llvm::errs() << "block data {\n" << symTab << "\n}\n";
}
-std::vector<Fortran::lower::pft::Variable>
-Fortran::lower::pft::buildFuncResultDependencyList(
- const Fortran::semantics::Symbol &symbol) {
- std::vector<std::vector<pft::Variable>> variableList;
- SymbolDependenceDepth sdd(variableList);
- sdd.analyzeAliasesInCurrentScope(symbol.owner());
+/// Find, or create and cache, a list of equivalence sets and variables in
+/// a (module or submodule) \p scope.
+lower::pft::VariableList *
+lower::pft::getCachedVariableList(const semantics::Scope *scope,
+ lower::pft::Program &root) {
+ assert(scope->kind() == semantics::Scope::Kind::Module &&
+ "expecting a module scope");
+ LLVM_DEBUG(llvm::dbgs() << "\ngetCachedVariableList of [sub]module scope <"
+ << scope << "> " << *scope->GetName() << "\n");
+ ScopeVariableListMap &map = root.getModuleScopeVariableListMap();
+ auto iter = map.find(scope);
+ if (iter != map.end())
+ return &iter->second;
+ lower::pft::VariableList variableList;
+ SymbolDependenceDepth sdd;
+ sdd.analyzeEquivalenceSets(*scope);
+ for (const auto &iter : *scope)
+ sdd.analyze(iter.second.get());
+ sdd.finalize(variableList);
+ map.emplace(scope, std::move(variableList));
+ iter = map.find(scope);
+ return &iter->second;
+}
+
+/// Create a list of equivalences and variables in \p scope (no caching).
+lower::pft::VariableList
+lower::pft::getVariableList(const semantics::Scope *scope) {
+ LLVM_DEBUG(llvm::dbgs() << "\ngetVariableList of [sub]program|block scope <"
+ << scope << "> " << *scope->GetName() << "\n");
+ lower::pft::VariableList variableList;
+ SymbolDependenceDepth sdd;
+ sdd.analyzeEquivalenceSets(*scope);
+ for (const auto &iter : *scope)
+ sdd.analyze(iter.second.get());
+ sdd.finalize(variableList);
+ return variableList;
+}
+
+/// Create a list of equivalences and variables that define a function result
+/// \p symbol (no caching). Exclude the function result itself.
+lower::pft::VariableList
+lower::pft::buildFuncResultDependencyList(const semantics::Symbol &symbol) {
+ LLVM_DEBUG(llvm::dbgs() << "\nbuildFuncResultDependencyList of " << &symbol
+ << " - " << symbol << "\n");
+ lower::pft::VariableList variableList;
+ SymbolDependenceDepth sdd;
+ sdd.analyzeEquivalenceSets(symbol.owner());
sdd.analyze(symbol);
- sdd.finalize();
- // Remove the pft::variable for the result itself, only its dependencies
- // should be returned in the list.
- assert(!variableList[0].empty() && "must at least contain the result");
- assert(&variableList[0].back().getSymbol() == &symbol &&
- "result sym should be last");
- variableList[0].pop_back();
- return variableList[0];
+ sdd.finalize(variableList);
+ // Return result dependent variables, excluding the result variable itself.
+ assert(!variableList.empty() && &variableList.back().getSymbol() == &symbol &&
+ "result variable sym should be last");
+ variableList.pop_back();
+ return variableList;
}
namespace {
diff --git a/flang/test/Lower/pre-fir-tree01.f90 b/flang/test/Lower/pre-fir-tree01.f90
index 0af8eef28fc53..bc7a06fabe564 100644
--- a/flang/test/Lower/pre-fir-tree01.f90
+++ b/flang/test/Lower/pre-fir-tree01.f90
@@ -32,7 +32,7 @@ subroutine foo()
end
! CHECK: End BlockData
-! CHECK: ModuleLike
+! CHECK: Module test_mod
module test_mod
interface
! check specification parts are not part of the PFT.
@@ -75,9 +75,9 @@ subroutine subfoo()
end function
! CHECK: End Function foo2
end module
-! CHECK: End ModuleLike
+! CHECK: End Module test_mod
-! CHECK: ModuleLike
+! CHECK: Submodule test_mod_impl: submodule(test_mod) test_mod_impl
submodule (test_mod) test_mod_impl
contains
! CHECK: Subroutine foo
@@ -114,7 +114,7 @@ function subfoo2()
! CHECK: <<End IfConstruct>>
end procedure
end submodule
-! CHECK: End ModuleLike
+! CHECK: End Submodule test_mod_impl
! CHECK: BlockData
block data named_block
diff --git a/flang/test/Lower/pre-fir-tree02.f90 b/flang/test/Lower/pre-fir-tree02.f90
index 7cc55df4c0bb8..551cd454f8a0c 100644
--- a/flang/test/Lower/pre-fir-tree02.f90
+++ b/flang/test/Lower/pre-fir-tree02.f90
@@ -144,7 +144,7 @@ subroutine incr(i)
deallocate(x)
end
-! CHECK: ModuleLike
+! CHECK: Module test
module test
!! When derived type processing is implemented, remove all instances of:
!! - !![disable]
diff --git a/flang/test/Lower/pre-fir-tree06.f90 b/flang/test/Lower/pre-fir-tree06.f90
index 847da6e63be83..f84bcd8b58b2d 100644
--- a/flang/test/Lower/pre-fir-tree06.f90
+++ b/flang/test/Lower/pre-fir-tree06.f90
@@ -2,15 +2,15 @@
! Test structure of the Pre-FIR tree with OpenMP declarative construct
-! CHECK: ModuleLike
+! CHECK: Module m
module m
real, dimension(10) :: x
! CHECK-NEXT: OpenMPDeclarativeConstruct
!$omp threadprivate(x)
end
-! CHECK: End ModuleLike
+! CHECK: End Module m
-! CHECK: ModuleLike
+! CHECK: Module m2
module m2
integer, save :: i
! CHECK-NEXT: OpenMPDeclarativeConstruct
@@ -23,7 +23,7 @@ subroutine sub2()
i = 2;
end
end
-! CHECK: End ModuleLike
+! CHECK: End Module m2
! CHECK: Program main
program main
diff --git a/flang/test/Lower/pre-fir-tree07.f90 b/flang/test/Lower/pre-fir-tree07.f90
index b12d6b7501bef..2c61e2b9b76c3 100644
--- a/flang/test/Lower/pre-fir-tree07.f90
+++ b/flang/test/Lower/pre-fir-tree07.f90
@@ -2,11 +2,10 @@
! Test structure of the Pre-FIR tree with OpenACC declarative construct
-! CHECK: ModuleLike
+! CHECK: Module m: module m
module m
real, dimension(10) :: x
! CHECK-NEXT: OpenACCDeclarativeConstruct
!$acc declare create(x)
end
-! CHECK: End ModuleLike
-
+! CHECK: End Module m
diff --git a/flang/test/Lower/submodule.f90 b/flang/test/Lower/submodule.f90
new file mode 100644
index 0000000000000..9836f45d2dce0
--- /dev/null
+++ b/flang/test/Lower/submodule.f90
@@ -0,0 +1,138 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module mm
+ integer :: vv = 20
+ interface
+ module function ff1(nn)
+ integer ff1(nn+1)
+ end function ff1
+ module function ff2(nn)
+ integer ff2(nn+2)
+ end function ff2
+ module function ff3(nn)
+ integer ff3(nn+3)
+ end function ff3
+ end interface
+end module mm
+
+submodule(mm) ss1
+ integer :: ww = 20
+ interface
+ module function fff(nn)
+ integer fff
+ end function fff
+ end interface
+contains
+ ! CHECK-LABEL: func @_QMmmPff2
+ ! CHECK: %[[V_0:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_1:[0-9]+]] = arith.addi %[[V_0]], %c2{{.*}} : i32
+ ! CHECK: %[[V_2:[0-9]+]] = fir.convert %[[V_1]] : (i32) -> i64
+ ! CHECK: %[[V_3:[0-9]+]] = fir.convert %[[V_2]] : (i64) -> index
+ ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi sgt, %[[V_3]], %c0{{.*}} : index
+ ! CHECK: %[[V_5:[0-9]+]] = arith.select %[[V_4]], %[[V_3]], %c0{{.*}} : index
+ ! CHECK: %[[V_6:[0-9]+]] = fir.alloca !fir.array<?xi32>, %[[V_5]] {bindc_name = "ff2", uniq_name = "_QMmmSss1Fff2Eff2"}
+ ! CHECK: %[[V_7:[0-9]+]] = fir.shape %[[V_5]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_8:[0-9]+]] = fir.array_load %[[V_6]](%[[V_7]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.array<?xi32>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.call @_QMmmSss1Pfff(%arg0) {{.*}} : (!fir.ref<i32>) -> i32
+ ! CHECK: %[[V_10:[0-9]+]] = arith.subi %[[V_5]], %c1{{.*}} : index
+ ! CHECK: %[[V_11:[0-9]+]] = fir.do_loop %arg1 = %c0{{.*}} to %[[V_10]] step %c1{{.*}} unordered iter_args(%arg2 = %[[V_8]]) -> (!fir.array<?xi32>) {
+ ! CHECK: %[[V_13:[0-9]+]] = fir.array_update %arg2, %[[V_9]], %arg1 : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+ ! CHECK: fir.result %[[V_13]] : !fir.array<?xi32>
+ ! CHECK: }
+ ! CHECK: fir.array_merge_store %[[V_8]], %[[V_11]] to %[[V_6]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.ref<!fir.array<?xi32>>
+ ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_6]] : !fir.ref<!fir.array<?xi32>>
+ ! CHECK: return %[[V_12]] : !fir.array<?xi32>
+ ! CHECK: }
+ module procedure ff2
+ ff2 = fff(nn)
+ end procedure ff2
+end submodule ss1
+
+submodule(mm:ss1) ss2
+contains
+ ! CHECK-LABEL: func @_QMmmPff1
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.address_of(@_QMmmEvv) : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_2:[0-9]+]] = arith.addi %[[V_1]], %c1{{.*}} : i32
+ ! CHECK: %[[V_3:[0-9]+]] = fir.convert %[[V_2]] : (i32) -> i64
+ ! CHECK: %[[V_4:[0-9]+]] = fir.convert %[[V_3]] : (i64) -> index
+ ! CHECK: %[[V_5:[0-9]+]] = arith.cmpi sgt, %[[V_4]], %c0{{.*}} : index
+ ! CHECK: %[[V_6:[0-9]+]] = arith.select %[[V_5]], %[[V_4]], %c0{{.*}} : index
+ ! CHECK: %[[V_7:[0-9]+]] = fir.alloca !fir.array<?xi32>, %[[V_6]] {bindc_name = "ff1", uniq_name = "_QMmmSss1Sss2Fff1Eff1"}
+ ! CHECK: %[[V_8:[0-9]+]] = fir.shape %[[V_6]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.array_load %[[V_7]](%[[V_8]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.array<?xi32>
+ ! CHECK: %[[V_10:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: %[[V_11:[0-9]+]] = arith.addi %[[V_10]], %c2{{.*}} : i32
+ ! CHECK: %[[V_12:[0-9]+]] = arith.subi %[[V_6]], %c1{{.*}} : index
+ ! CHECK: %[[V_13:[0-9]+]] = fir.do_loop %arg1 = %c0{{.*}} to %[[V_12]] step %c1{{.*}} unordered iter_args(%arg2 = %[[V_9]]) -> (!fir.array<?xi32>) {
+ ! CHECK: %[[V_15:[0-9]+]] = fir.array_update %arg2, %[[V_11]], %arg1 : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+ ! CHECK: fir.result %[[V_15]] : !fir.array<?xi32>
+ ! CHECK: }
+ ! CHECK: fir.array_merge_store %[[V_9]], %[[V_13]] to %[[V_7]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.ref<!fir.array<?xi32>>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.load %[[V_7]] : !fir.ref<!fir.array<?xi32>>
+ ! CHECK: return %[[V_14]] : !fir.array<?xi32>
+ ! CHECK: }
+ module function ff1(nn)
+ integer ff1(nn+1)
+ ff1 = vv + 2
+ end function ff1
+
+ ! CHECK-LABEL: func @_QMmmSss1Pfff
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.address_of(@_QMmmSss1Eww) : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.address_of(@_QMmmEvv) : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca i32 {bindc_name = "fff", uniq_name = "_QMmmSss1Sss2FfffEfff"}
+ ! CHECK-DAG: %[[V_3:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: %[[V_5:[0-9]+]] = arith.addi %[[V_3]], %[[V_4]] : i32
+ ! CHECK: %[[V_6:[0-9]+]] = arith.addi %[[V_5]], %c4{{.*}} : i32
+ ! CHECK: fir.store %[[V_6]] to %[[V_2]] : !fir.ref<i32>
+ ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<i32>
+ ! CHECK: return %[[V_7]] : i32
+ ! CHECK: }
+ module procedure fff
+ fff = vv + ww + 4
+ end procedure fff
+end submodule ss2
+
+submodule(mm) sss
+contains
+ ! CHECK-LABEL: func @_QMmmPff3
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.address_of(@_QMmmEvv) : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_2:[0-9]+]] = arith.addi %[[V_1]], %c3{{.*}} : i32
+ ! CHECK: %[[V_3:[0-9]+]] = fir.convert %[[V_2]] : (i32) -> i64
+ ! CHECK: %[[V_4:[0-9]+]] = fir.convert %[[V_3]] : (i64) -> index
+ ! CHECK: %[[V_5:[0-9]+]] = arith.cmpi sgt, %[[V_4]], %c0{{.*}} : index
+ ! CHECK: %[[V_6:[0-9]+]] = arith.select %[[V_5]], %[[V_4]], %c0{{.*}} : index
+ ! CHECK: %[[V_7:[0-9]+]] = fir.alloca !fir.array<?xi32>, %[[V_6]] {bindc_name = "ff3", uniq_name = "_QMmmSsssFff3Eff3"}
+ ! CHECK: %[[V_8:[0-9]+]] = fir.shape %[[V_6]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.array_load %[[V_7]](%[[V_8]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.array<?xi32>
+ ! CHECK-DAG: %[[V_10:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK-DAG: %[[V_11:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: %[[V_12:[0-9]+]] = arith.muli %[[V_10]], %[[V_11]] : i32
+ ! CHECK: %[[V_13:[0-9]+]] = arith.addi %[[V_12]], %c6{{.*}} : i32
+ ! CHECK: %[[V_14:[0-9]+]] = arith.subi %[[V_6]], %c1{{.*}} : index
+ ! CHECK: %[[V_15:[0-9]+]] = fir.do_loop %arg1 = %c0{{.*}} to %[[V_14]] step %c1{{.*}} unordered iter_args(%arg2 = %[[V_9]]) -> (!fir.array<?xi32>) {
+ ! CHECK: %[[V_17:[0-9]+]] = fir.array_update %arg2, %[[V_13]], %arg1 : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+ ! CHECK: fir.result %[[V_17]] : !fir.array<?xi32>
+ ! CHECK: }
+ ! CHECK: fir.array_merge_store %[[V_9]], %[[V_15]] to %[[V_7]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.ref<!fir.array<?xi32>>
+ ! CHECK: %[[V_16:[0-9]+]] = fir.load %[[V_7]] : !fir.ref<!fir.array<?xi32>>
+ ! CHECK: return %[[V_16]] : !fir.array<?xi32>
+ ! CHECK: }
+ module function ff3(nn)
+ integer ff3(nn+3)
+ ff3 = nn*vv + 6
+ end function ff3
+end submodule sss
+
+! CHECK-LABEL: func @_QQmain
+program pp
+ use mm
+ ! CHECK: fir.call @_QMmmPff1(%{{[0-9]+}}) {{.*}} : (!fir.ref<i32>) -> !fir.array<?xi32>
+ print*, ff1(1) ! expect: 22 22
+ ! CHECK: fir.call @_QMmmPff2(%{{[0-9]+}}) {{.*}} : (!fir.ref<i32>) -> !fir.array<?xi32>
+ print*, ff2(2) ! expect: 44 44 44 44
+ ! CHECK: fir.call @_QMmmPff3(%{{[0-9]+}}) {{.*}} : (!fir.ref<i32>) -> !fir.array<?xi32>
+ print*, ff3(3) ! expect: 66 66 66 66 66 66
+end program pp
More information about the llvm-branch-commits
mailing list