[flang][fir] Upstream the pre-FIR tree changes.
The PFT has been updated to support Fortran 77.
clang-tidy cleanup.
Authors: Val Donaldson, Jean Perier, Eric Schweitz, et.al.
Differential Revision: https://reviews.llvm.org/D98283
GitOrigin-RevId: 987ee6e3cc1fb672b3ed201e72a5281c2ec88c99
diff --git a/include/flang/Lower/IO.h b/include/flang/Lower/IO.h
index 9d5147f..cbfd6df 100644
--- a/include/flang/Lower/IO.h
+++ b/include/flang/Lower/IO.h
@@ -43,7 +43,7 @@
struct Evaluation;
using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
using SymbolRef = Fortran::common::Reference<const Fortran::semantics::Symbol>;
-using LabelSet = llvm::SmallSet<Fortran::parser::Label, 5>;
+using LabelSet = llvm::SmallSet<Fortran::parser::Label, 4>;
using SymbolLabelMap = llvm::DenseMap<SymbolRef, LabelSet>;
} // namespace pft
diff --git a/include/flang/Lower/PFTBuilder.h b/include/flang/Lower/PFTBuilder.h
index 044e608..16abf6b 100644
--- a/include/flang/Lower/PFTBuilder.h
+++ b/include/flang/Lower/PFTBuilder.h
@@ -6,6 +6,10 @@
//
//===----------------------------------------------------------------------===//
//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+//
// PFT (Pre-FIR Tree) interface.
//
//===----------------------------------------------------------------------===//
@@ -15,31 +19,20 @@
#include "flang/Common/reference.h"
#include "flang/Common/template.h"
+#include "flang/Lower/PFTDefs.h"
#include "flang/Parser/parse-tree.h"
-#include "llvm/ADT/DenseMap.h"
-#include "llvm/ADT/SmallSet.h"
+#include "flang/Semantics/attr.h"
+#include "flang/Semantics/symbol.h"
+#include "llvm/Support/ErrorHandling.h"
#include "llvm/Support/raw_ostream.h"
-namespace mlir {
-class Block;
-}
-
-namespace Fortran {
-namespace semantics {
-class SemanticsContext;
-class Scope;
-} // namespace semantics
-namespace lower {
-namespace pft {
+namespace Fortran::lower::pft {
struct Evaluation;
struct Program;
struct ModuleLikeUnit;
struct FunctionLikeUnit;
-// TODO: A collection of Evaluations can obviously be any of the container
-// types; leaving this as a std::list _for now_ because we reserve the right to
-// insert PFT nodes in any order in O(1) time.
using EvaluationList = std::list<Evaluation>;
using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
@@ -61,7 +54,11 @@
template <typename B>
constexpr BaseType<B> &get() const {
- return std::get<Ref<B>> > (u).get();
+ return std::get<Ref<B>>(u).get();
+ }
+ template <typename B>
+ constexpr BaseType<B> &getStatement() const {
+ return std::get<Ref<parser::Statement<B>>>(u).get().statement;
}
template <typename B>
constexpr BaseType<B> *getIf() const {
@@ -87,10 +84,10 @@
template <typename... A>
using MutableReferenceVariant = ReferenceVariantBase<false, A...>;
-/// ParentVariant is used to provide a reference to the unit a parse-tree node
+/// PftNode is used to provide a reference to the unit a parse-tree node
/// belongs to. It is a variant of non-nullable pointers.
-using ParentVariant = MutableReferenceVariant<Program, ModuleLikeUnit,
- FunctionLikeUnit, Evaluation>;
+using PftNode = MutableReferenceVariant<Program, ModuleLikeUnit,
+ FunctionLikeUnit, Evaluation>;
/// Classify the parse-tree nodes from ExecutablePartConstruct
@@ -109,8 +106,8 @@
parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
-using OtherStmts = std::tuple<parser::FormatStmt, parser::EntryStmt,
- parser::DataStmt, parser::NamelistStmt>;
+using OtherStmts =
+ std::tuple<parser::FormatStmt, parser::EntryStmt, parser::NamelistStmt>;
using ConstructStmts = std::tuple<
parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
@@ -123,6 +120,10 @@
parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt,
parser::ForallConstructStmt, parser::EndForallStmt>;
+using EndStmts =
+ std::tuple<parser::EndProgramStmt, parser::EndFunctionStmt,
+ parser::EndSubroutineStmt, parser::EndMpSubprogramStmt>;
+
using Constructs =
std::tuple<parser::AssociateConstruct, parser::BlockConstruct,
parser::CaseConstruct, parser::ChangeTeamConstruct,
@@ -145,6 +146,9 @@
static constexpr bool isConstructStmt{common::HasMember<A, ConstructStmts>};
template <typename A>
+static constexpr bool isEndStmt{common::HasMember<A, EndStmts>};
+
+template <typename A>
static constexpr bool isConstruct{common::HasMember<A, Constructs>};
template <typename A>
@@ -168,10 +172,6 @@
parser::SubroutineSubprogram,
parser::SeparateModuleSubprogram>>};
-using LabelSet = llvm::SmallSet<parser::Label, 5>;
-using SymbolRef = common::Reference<const semantics::Symbol>;
-using SymbolLabelMap = llvm::DenseMap<SymbolRef, LabelSet>;
-
template <typename A>
struct MakeReferenceVariantHelper {};
template <typename... A>
@@ -186,8 +186,8 @@
using MakeReferenceVariant = typename MakeReferenceVariantHelper<A>::type;
using EvaluationTuple =
- common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, Constructs,
- Directives>;
+ common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, EndStmts,
+ Constructs, Directives>;
/// Hide non-nullable pointers to the parse-tree node.
/// Build type std::variant<const A* const, const B* const, ...>
/// from EvaluationTuple type (std::tuple<A, B, ...>).
@@ -199,16 +199,16 @@
/// General ctor
template <typename A>
- Evaluation(const A &a, const ParentVariant &parentVariant,
+ Evaluation(const A &a, const PftNode &parent,
const parser::CharBlock &position,
const std::optional<parser::Label> &label)
- : EvaluationVariant{a},
- parentVariant{parentVariant}, position{position}, label{label} {}
+ : EvaluationVariant{a}, parent{parent}, position{position}, label{label} {
+ }
- /// Construct ctor
+ /// Construct and Directive ctor
template <typename A>
- Evaluation(const A &a, const ParentVariant &parentVariant)
- : EvaluationVariant{a}, parentVariant{parentVariant} {
+ Evaluation(const A &a, const PftNode &parent)
+ : EvaluationVariant{a}, parent{parent} {
static_assert(pft::isConstruct<A> || pft::isDirective<A>,
"must be a construct or directive");
}
@@ -227,6 +227,10 @@
return pft::isConstructStmt<std::decay_t<decltype(r)>>;
}});
}
+ constexpr bool isEndStmt() const {
+ return visit(common::visitors{
+ [](auto &r) { return pft::isEndStmt<std::decay_t<decltype(r)>>; }});
+ }
constexpr bool isConstruct() const {
return visit(common::visitors{
[](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
@@ -249,6 +253,8 @@
}});
}
+ LLVM_DUMP_METHOD void dump() const;
+
/// Return the first non-nop successor of an evaluation, possibly exiting
/// from one or more enclosing constructs.
Evaluation &nonNopSuccessor() const {
@@ -287,14 +293,13 @@
bool lowerAsStructured() const;
bool lowerAsUnstructured() const;
- // FIR generation looks primarily at PFT statement (leaf) nodes. So members
- // such as lexicalSuccessor and the various block fields are only applicable
- // to statement nodes. One exception is that an internal construct node is
- // a convenient place for a constructExit link that applies to exits from any
- // statement within the construct. The controlSuccessor member is used for
- // nonlexical successors, such as linking to a GOTO target. For multiway
- // branches, controlSuccessor is set to one of the targets (might as well be
- // the first target). Successor and exit links always target statements.
+ // FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf
+ // nodes. Members such as lexicalSuccessor and block are applicable only
+ // to these nodes. The controlSuccessor member is used for nonlexical
+ // successors, such as linking to a GOTO target. For multiway branches,
+ // it is set to the first target. Successor and exit links always target
+ // statements. An internal Construct node has a constructExit link that
+ // applies to exits from anywhere within the construct.
//
// An unstructured construct is one that contains some form of goto. This
// is indicated by the isUnstructured member flag, which may be set on a
@@ -303,25 +308,21 @@
// FIR operations. An unstructured statement is materialized as mlir
// operation sequences that include explicit branches.
//
- // There are two mlir::Block members. The block member is set for statements
- // that begin a new block. If a statement may have more than one associated
- // block, this member must be the block that would be the target of a branch
- // to the statement. The prime example of a statement that may have multiple
- // associated blocks is NonLabelDoStmt, which may have a loop preheader block
- // for loop initialization code, and always has a header block that is the
- // target of the loop back edge. If the NonLabelDoStmt is a concurrent loop,
- // there may be an arbitrary number of nested preheader, header, and mask
- // blocks. Any such additional blocks in the localBlocks member are local
- // to a construct and cannot be the target of an unstructured branch. For
- // NonLabelDoStmt, the block member designates the preheader block, which may
- // be absent if loop initialization code may be appended to a predecessor
- // block. The primary loop header block is localBlocks[0], with additional
- // DO CONCURRENT blocks at localBlocks[1], etc.
+ // The block member is set for statements that begin a new block. This
+ // block is the target of any branch to the statement. Statements may have
+ // additional (unstructured) "local" blocks, but such blocks cannot be the
+ // target of any explicit branch. The primary example of an (unstructured)
+ // statement that may have multiple associated blocks is NonLabelDoStmt,
+ // which may have a loop preheader block for loop initialization code (the
+ // block member), and always has a "local" header block that is the target
+ // of the loop back edge. If the NonLabelDoStmt is a concurrent loop, it
+ // may be associated with an arbitrary number of nested preheader, header,
+ // and mask blocks.
//
// The printIndex member is only set for statements. It is used for dumps
- // and does not affect FIR generation. It may also be helpful for debugging.
+ // (and debugging) and does not affect FIR generation.
- ParentVariant parentVariant;
+ PftNode parent;
parser::CharBlock position{};
std::optional<parser::Label> label{};
std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
@@ -331,9 +332,8 @@
Evaluation *constructExit{nullptr}; // set for constructs
bool isNewBlock{false}; // evaluation begins a new basic block
bool isUnstructured{false}; // evaluation has unstructured control flow
- bool skip{false}; // evaluation has been processed in advance
- mlir::Block *block{nullptr}; // isNewBlock block
- llvm::SmallVector<mlir::Block *, 1> localBlocks{}; // construct local blocks
+ bool negateCondition{false}; // If[Then]Stmt condition must be negated
+ mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt)
int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
};
@@ -341,49 +341,201 @@
ReferenceVariant<parser::MainProgram, parser::FunctionSubprogram,
parser::SubroutineSubprogram, parser::Module,
parser::Submodule, parser::SeparateModuleSubprogram,
- parser::BlockData>;
+ parser::BlockData, parser::CompilerDirective>;
/// A program is a list of program units.
/// These units can be function like, module like, or block data.
struct ProgramUnit : ProgramVariant {
template <typename A>
- ProgramUnit(const A &p, const ParentVariant &parentVariant)
- : ProgramVariant{p}, parentVariant{parentVariant} {}
+ ProgramUnit(const A &p, const PftNode &parent)
+ : ProgramVariant{p}, parent{parent} {}
ProgramUnit(ProgramUnit &&) = default;
ProgramUnit(const ProgramUnit &) = delete;
- ParentVariant parentVariant;
+ PftNode parent;
};
/// A variable captures an object to be created per the declaration part of a
/// function like unit.
///
+/// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing
+/// between named variables. The set of overlapping aliases will materialize a
+/// generic store object with a designated offset and size. Participant
+/// symbols will simply be pointers into the aggregate store.
+///
+/// EQUIVALENCE can also interact with COMMON and other global variables to
+/// imply aliasing between (subparts of) a global and other local variable
+/// names.
+///
/// Properties can be applied by lowering. For example, a local array that is
/// known to be very large may be transformed into a heap allocated entity by
/// lowering. That decision would be tracked in its Variable instance.
struct Variable {
+ /// Most variables are nominal and require the allocation of local/global
+ /// storage space. A nominal variable may also be an alias for some other
+ /// (subpart) of storage.
+ struct Nominal {
+ Nominal(const semantics::Symbol *symbol, int depth, bool global)
+ : symbol{symbol}, depth{depth}, global{global} {}
+ const semantics::Symbol *symbol{};
+
+ bool isGlobal() const { return global; }
+ bool isDeclaration() const {
+ return !symbol || symbol != &symbol->GetUltimate();
+ }
+
+ int depth{};
+ bool global{};
+ bool heapAlloc{}; // variable needs deallocation on exit
+ bool pointer{};
+ bool target{};
+ bool aliaser{}; // participates in EQUIVALENCE union
+ std::size_t aliasOffset{};
+ };
+
+ using Interval = std::tuple<std::size_t, std::size_t>;
+
+ /// An interval of storage is a contiguous block of memory to be allocated or
+ /// mapped onto another variable. Aliasing variables will be pointers into
+ /// interval stores and may overlap each other.
+ struct AggregateStore {
+ AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
+ bool isDeclaration = false)
+ : interval{std::move(interval)}, scope{&scope}, isDecl{isDeclaration} {}
+ AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
+ const llvm::SmallVector<const semantics::Symbol *, 8> &vars,
+ bool isDeclaration = false)
+ : interval{std::move(interval)}, scope{&scope}, vars{vars},
+ isDecl{isDeclaration} {}
+
+ bool isGlobal() const { return vars.size() > 0; }
+ bool isDeclaration() const { return isDecl; }
+ /// Get offset of the aggregate inside its scope.
+ std::size_t getOffset() const { return std::get<0>(interval); }
+
+ Interval interval{};
+ /// scope in which the interval is.
+ const Fortran::semantics::Scope *scope;
+ llvm::SmallVector<const semantics::Symbol *, 8> vars{};
+ /// Is this a declaration of a storage defined in another scope ?
+ bool isDecl;
+ };
+
explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
int depth = 0)
- : sym{&sym}, depth{depth}, global{global} {}
+ : var{Nominal(&sym, depth, global)} {}
+ explicit Variable(AggregateStore &&istore) : var{std::move(istore)} {}
- const Fortran::semantics::Symbol &getSymbol() const { return *sym; }
+ /// Return the front-end symbol for a nominal variable.
+ const Fortran::semantics::Symbol &getSymbol() const {
+ assert(hasSymbol() && "variable is not nominal");
+ return *std::get<Nominal>(var).symbol;
+ }
- bool isGlobal() const { return global; }
- bool isHeapAlloc() const { return heapAlloc; }
- bool isPointer() const { return pointer; }
- bool isTarget() const { return target; }
- int getDepth() const { return depth; }
+ /// Return the aggregate store.
+ const AggregateStore &getAggregateStore() const {
+ assert(isAggregateStore());
+ return std::get<AggregateStore>(var);
+ }
- void setHeapAlloc(bool to = true) { heapAlloc = to; }
- void setPointer(bool to = true) { pointer = to; }
- void setTarget(bool to = true) { target = to; }
+ /// Return the interval range of an aggregate store.
+ const Interval &getInterval() const {
+ assert(isAggregateStore());
+ return std::get<AggregateStore>(var).interval;
+ }
+
+ /// Only nominal variable have front-end symbols.
+ bool hasSymbol() const { return std::holds_alternative<Nominal>(var); }
+
+ /// Is this an aggregate store?
+ bool isAggregateStore() const {
+ return std::holds_alternative<AggregateStore>(var);
+ }
+
+ /// Is this variable a global?
+ bool isGlobal() const {
+ return std::visit([](const auto &x) { return x.isGlobal(); }, var);
+ }
+
+ /// Is this a declaration of a variable owned by another scope ?
+ bool isDeclaration() const {
+ return std::visit([](const auto &x) { return x.isDeclaration(); }, var);
+ }
+
+ const Fortran::semantics::Scope *getOwningScope() const {
+ return std::visit(
+ common::visitors{
+ [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
+ [](const AggregateStore &agg) { return agg.scope; }},
+ var);
+ }
+
+ bool isHeapAlloc() const {
+ if (const auto *s = std::get_if<Nominal>(&var))
+ return s->heapAlloc;
+ return false;
+ }
+ bool isPointer() const {
+ if (const auto *s = std::get_if<Nominal>(&var))
+ return s->pointer;
+ return false;
+ }
+ bool isTarget() const {
+ if (const auto *s = std::get_if<Nominal>(&var))
+ return s->target;
+ return false;
+ }
+
+ /// An alias(er) is a variable that is part of a EQUIVALENCE that is allocated
+ /// locally on the stack.
+ bool isAlias() const {
+ if (const auto *s = std::get_if<Nominal>(&var))
+ return s->aliaser;
+ return false;
+ }
+ std::size_t getAlias() const {
+ if (auto *s = std::get_if<Nominal>(&var))
+ return s->aliasOffset;
+ return 0;
+ }
+ void setAlias(std::size_t offset) {
+ if (auto *s = std::get_if<Nominal>(&var)) {
+ s->aliaser = true;
+ s->aliasOffset = offset;
+ } else {
+ llvm_unreachable("not a nominal var");
+ }
+ }
+
+ void setHeapAlloc(bool to = true) {
+ if (auto *s = std::get_if<Nominal>(&var))
+ s->heapAlloc = to;
+ else
+ llvm_unreachable("not a nominal var");
+ }
+ void setPointer(bool to = true) {
+ if (auto *s = std::get_if<Nominal>(&var))
+ s->pointer = to;
+ else
+ llvm_unreachable("not a nominal var");
+ }
+ void setTarget(bool to = true) {
+ if (auto *s = std::get_if<Nominal>(&var))
+ s->target = to;
+ else
+ llvm_unreachable("not a nominal var");
+ }
+
+ /// The depth is recorded for nominal variables as a debugging aid.
+ int getDepth() const {
+ if (const auto *s = std::get_if<Nominal>(&var))
+ return s->depth;
+ return 0;
+ }
+
+ LLVM_DUMP_METHOD void dump() const;
private:
- const Fortran::semantics::Symbol *sym;
- int depth;
- bool global;
- bool heapAlloc{false}; // variable needs deallocation on exit
- bool pointer{false};
- bool target{false};
+ std::variant<Nominal, AggregateStore> var;
};
/// Function-like units may contain evaluations (executable statements) and
@@ -401,22 +553,30 @@
parser::Statement<parser::EndMpSubprogramStmt>>;
FunctionLikeUnit(
- const parser::MainProgram &f, const ParentVariant &parentVariant,
+ const parser::MainProgram &f, const PftNode &parent,
const Fortran::semantics::SemanticsContext &semanticsContext);
FunctionLikeUnit(
- const parser::FunctionSubprogram &f, const ParentVariant &parentVariant,
+ const parser::FunctionSubprogram &f, const PftNode &parent,
const Fortran::semantics::SemanticsContext &semanticsContext);
FunctionLikeUnit(
- const parser::SubroutineSubprogram &f, const ParentVariant &parentVariant,
+ const parser::SubroutineSubprogram &f, const PftNode &parent,
const Fortran::semantics::SemanticsContext &semanticsContext);
FunctionLikeUnit(
- const parser::SeparateModuleSubprogram &f,
- const ParentVariant &parentVariant,
+ const parser::SeparateModuleSubprogram &f, const PftNode &parent,
const Fortran::semantics::SemanticsContext &semanticsContext);
FunctionLikeUnit(FunctionLikeUnit &&) = default;
FunctionLikeUnit(const FunctionLikeUnit &) = delete;
- void processSymbolTable(const Fortran::semantics::Scope &);
+ /// Return true iff this function like unit is Fortran recursive (actually
+ /// meaning it's reentrant).
+ bool isRecursive() const {
+ if (isMainProgram())
+ return false;
+ const auto &sym = getSubprogramSymbol();
+ return sym.attrs().test(semantics::Attr::RECURSIVE) ||
+ (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) &&
+ defaultRecursiveFunctionSetting());
+ }
std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
@@ -433,18 +593,36 @@
return stmtSourceLoc(endStmt);
}
- /// Returns reference to the subprogram symbol of this FunctionLikeUnit.
- /// Dies if the FunctionLikeUnit is not a subprogram.
+ void setActiveEntry(int entryIndex) {
+ assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() &&
+ "invalid entry point index");
+ activeEntry = entryIndex;
+ }
+
+ /// Return a reference to the subprogram symbol of this FunctionLikeUnit.
+ /// This should not be called if the FunctionLikeUnit is the main program
+ /// since anonymous main programs do not have a symbol.
const semantics::Symbol &getSubprogramSymbol() const {
- assert(symbol && "not inside a procedure");
+ const auto *symbol = entryPointList[activeEntry].first;
+ if (!symbol)
+ llvm::report_fatal_error(
+ "not inside a procedure; do not call on main program.");
return *symbol;
}
+ /// Return a pointer to the current entry point Evaluation.
+ /// This is null for a primary entry point.
+ Evaluation *getEntryEval() const {
+ return entryPointList[activeEntry].second;
+ }
+
/// Helper to get location from FunctionLikeUnit begin/end statements.
static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) {
return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
}
+ LLVM_DUMP_METHOD void dump() const;
+
/// Anonymous programs do not have a begin statement
std::optional<FunctionStatement> beginStmt;
FunctionStatement endStmt;
@@ -452,11 +630,20 @@
LabelEvalMap labelEvaluationMap;
SymbolLabelMap assignSymbolLabelMap;
std::list<FunctionLikeUnit> nestedFunctions;
- /// Symbol associated to this FunctionLikeUnit.
- /// Null if the FunctionLikeUnit is an anonymous program.
- /// The symbol has MainProgramDetails for named programs, otherwise it has
- /// SubprogramDetails.
- const semantics::Symbol *symbol{nullptr};
+ /// <Symbol, Evaluation> pairs for each entry point. The pair at index 0
+ /// is the primary entry point; remaining pairs are alternate entry points.
+ /// The primary entry point symbol is Null for an anonymous program.
+ /// A named program symbol has MainProgramDetails. Other symbols have
+ /// SubprogramDetails. Evaluations are filled in for alternate entries.
+ llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
+ entryPointList{std::pair{nullptr, nullptr}};
+ /// Current index into entryPointList. Index 0 is the primary entry point.
+ int activeEntry = 0;
+ /// Dummy arguments that are not universal across entry points.
+ llvm::SmallVector<const semantics::Symbol *, 3> nonUniversalDummyArguments;
+ /// Primary result for function subprograms with alternate entries. This
+ /// is one of the largest result values, not necessarily the first one.
+ const semantics::Symbol *primaryResult{nullptr};
/// Terminal basic block (if any)
mlir::Block *finalBlock{};
std::vector<std::vector<Variable>> varList;
@@ -471,44 +658,66 @@
parser::Statement<parser::SubmoduleStmt>,
parser::Statement<parser::EndSubmoduleStmt>>;
- ModuleLikeUnit(const parser::Module &m, const ParentVariant &parentVariant);
- ModuleLikeUnit(const parser::Submodule &m,
- const ParentVariant &parentVariant);
+ ModuleLikeUnit(const parser::Module &m, const PftNode &parent);
+ ModuleLikeUnit(const parser::Submodule &m, const PftNode &parent);
~ModuleLikeUnit() = default;
ModuleLikeUnit(ModuleLikeUnit &&) = default;
ModuleLikeUnit(const ModuleLikeUnit &) = delete;
+ LLVM_DUMP_METHOD void dump() const;
+
+ std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
+
ModuleStatement beginStmt;
ModuleStatement endStmt;
std::list<FunctionLikeUnit> nestedFunctions;
+ std::vector<std::vector<Variable>> varList;
};
+/// Block data units contain the variables and data initializers for common
+/// blocks, etc.
struct BlockDataUnit : public ProgramUnit {
- BlockDataUnit(const parser::BlockData &bd,
- const ParentVariant &parentVariant);
+ BlockDataUnit(const parser::BlockData &bd, const PftNode &parent,
+ const Fortran::semantics::SemanticsContext &semanticsContext);
BlockDataUnit(BlockDataUnit &&) = default;
BlockDataUnit(const BlockDataUnit &) = delete;
+
+ LLVM_DUMP_METHOD void dump() const;
+
+ const Fortran::semantics::Scope &symTab; // symbol table
+};
+
+// Top level compiler directives
+struct CompilerDirectiveUnit : public ProgramUnit {
+ CompilerDirectiveUnit(const parser::CompilerDirective &directive,
+ const PftNode &parent)
+ : ProgramUnit{directive, parent} {};
+ CompilerDirectiveUnit(CompilerDirectiveUnit &&) = default;
+ CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete;
};
/// A Program is the top-level root of the PFT.
struct Program {
- using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit>;
+ using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit,
+ CompilerDirectiveUnit>;
Program() = default;
Program(Program &&) = default;
Program(const Program &) = delete;
+ const std::list<Units> &getUnits() const { return units; }
std::list<Units> &getUnits() { return units; }
/// LLVM dump method on a Program.
- void dump();
+ LLVM_DUMP_METHOD void dump() const;
private:
std::list<Units> units;
};
-} // namespace pft
+} // namespace Fortran::lower::pft
+namespace Fortran::lower {
/// Create a PFT (Pre-FIR Tree) from the parse tree.
///
/// A PFT is a light weight tree over the parse tree that is used to create FIR.
@@ -522,9 +731,8 @@
const Fortran::semantics::SemanticsContext &semanticsContext);
/// Dumper for displaying a PFT.
-void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft);
+void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft);
-} // namespace lower
-} // namespace Fortran
+} // namespace Fortran::lower
#endif // FORTRAN_LOWER_PFTBUILDER_H
diff --git a/include/flang/Lower/PFTDefs.h b/include/flang/Lower/PFTDefs.h
new file mode 100644
index 0000000..4dc3175
--- /dev/null
+++ b/include/flang/Lower/PFTDefs.h
@@ -0,0 +1,62 @@
+//===-- Lower/PFTDefs.h -- shared PFT info ----------------------*- 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_PFTDEFS_H
+#define FORTRAN_LOWER_PFTDEFS_H
+
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/SmallSet.h"
+#include "llvm/ADT/StringRef.h"
+
+namespace mlir {
+class Block;
+}
+
+namespace Fortran {
+namespace semantics {
+class Symbol;
+class SemanticsContext;
+class Scope;
+} // namespace semantics
+
+namespace evaluate {
+template <typename A>
+class Expr;
+struct SomeType;
+} // namespace evaluate
+
+namespace common {
+template <typename A>
+class Reference;
+}
+
+namespace lower {
+
+bool definedInCommonBlock(const semantics::Symbol &sym);
+bool defaultRecursiveFunctionSetting();
+
+namespace pft {
+
+struct Evaluation;
+
+using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
+using SymbolRef = Fortran::common::Reference<const Fortran::semantics::Symbol>;
+using Label = std::uint64_t;
+using LabelSet = llvm::SmallSet<Label, 4>;
+using SymbolLabelMap = llvm::DenseMap<SymbolRef, LabelSet>;
+using LabelEvalMap = llvm::DenseMap<Label, Evaluation *>;
+
+} // namespace pft
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_PFTDEFS_H
diff --git a/include/flang/Lower/Support/Utils.h b/include/flang/Lower/Support/Utils.h
new file mode 100644
index 0000000..7884634
--- /dev/null
+++ b/include/flang/Lower/Support/Utils.h
@@ -0,0 +1,49 @@
+//===-- Lower/Support/Utils.h -- utilities ----------------------*- 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_UTILS_H
+#define FORTRAN_LOWER_SUPPORT_UTILS_H
+
+#include "flang/Common/indirection.h"
+#include "flang/Parser/char-block.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+#include "mlir/IR/BuiltinAttributes.h"
+#include "llvm/ADT/StringRef.h"
+#include <cstdint>
+
+//===----------------------------------------------------------------------===//
+// Small inline helper functions to deal with repetitive, clumsy conversions.
+//===----------------------------------------------------------------------===//
+
+/// Convert an F18 CharBlock to an LLVM StringRef.
+inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) {
+ return {cb.begin(), cb.size()};
+}
+
+namespace fir {
+/// Return the integer value of a ConstantOp.
+inline std::int64_t toInt(mlir::ConstantOp cop) {
+ return cop.getValue().cast<mlir::IntegerAttr>().getValue().getSExtValue();
+}
+} // namespace fir
+
+/// Template helper to remove Fortran::common::Indirection wrappers.
+template <typename A>
+const A &removeIndirection(const A &a) {
+ return a;
+}
+template <typename A>
+const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
+ return a.value();
+}
+
+#endif // FORTRAN_LOWER_SUPPORT_UTILS_H
diff --git a/lib/Lower/IntervalSet.h b/lib/Lower/IntervalSet.h
new file mode 100644
index 0000000..fddeea3
--- /dev/null
+++ b/lib/Lower/IntervalSet.h
@@ -0,0 +1,109 @@
+//===-- IntervalSet.h -------------------------------------------*- 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_INTERVALSET_H
+#define FORTRAN_LOWER_INTERVALSET_H
+
+#include <cassert>
+#include <map>
+
+namespace Fortran::lower {
+
+//===----------------------------------------------------------------------===//
+// Interval set
+//===----------------------------------------------------------------------===//
+
+/// Interval set to keep track of intervals, merging them when they overlap one
+/// another. Used to refine the pseudo-offset ranges of the front-end symbols
+/// into groups of aliasing variables.
+struct IntervalSet {
+ using MAP = std::map<std::size_t, std::size_t>;
+ using Iterator = MAP::const_iterator;
+
+ // Handles the merging of overlapping intervals correctly, efficiently.
+ void merge(std::size_t lo, std::size_t up) {
+ assert(lo <= up);
+ if (empty()) {
+ m.insert({lo, up});
+ return;
+ }
+ auto i = m.lower_bound(lo);
+ // i->first >= lo
+ if (i == begin()) {
+ if (up < i->first) {
+ // [lo..up] < i->first
+ m.insert({lo, up});
+ return;
+ }
+ // up >= i->first
+ if (i->second > up)
+ up = i->second;
+ fuse(lo, up, i);
+ return;
+ }
+ auto i1 = i;
+ if (i == end() || i->first > lo)
+ i = std::prev(i);
+ // i->first <= lo
+ if (i->second >= up) {
+ // i->first <= lo && up <= i->second, keep i
+ return;
+ }
+ // i->second < up
+ if (i->second < lo) {
+ if (i1 == end() || i1->first > up) {
+ // i < [lo..up] < i1
+ m.insert({lo, up});
+ return;
+ }
+ // i < [lo..up], i1->first <= up --> [lo..up] union [i1..?]
+ i = i1;
+ } else {
+ // i->first <= lo, lo <= i->second --> [i->first..up] union [i..?]
+ lo = i->first;
+ }
+ fuse(lo, up, i);
+ }
+
+ Iterator find(std::size_t pt) const {
+ auto i = m.lower_bound(pt);
+ if (i != end() && i->first == pt)
+ return i;
+ if (i == begin())
+ return end();
+ i = std::prev(i);
+ if (i->second < pt)
+ return end();
+ return i;
+ }
+
+ Iterator begin() const { return m.begin(); }
+ Iterator end() const { return m.end(); }
+ bool empty() const { return m.empty(); }
+ std::size_t size() const { return m.size(); }
+
+private:
+ // Find and fuse overlapping sets.
+ void fuse(std::size_t lo, std::size_t up, Iterator i) {
+ auto j = m.upper_bound(up);
+ // up < j->first
+ auto cu = std::prev(j)->second;
+ // cu < j->first
+ if (cu > up)
+ up = cu;
+ m.erase(i, j);
+ // merge [i .. j) with [i->first, max(up, cu)]
+ m.insert({lo, up});
+ }
+
+ MAP m{};
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_INTERVALSET_H
diff --git a/lib/Lower/PFTBuilder.cpp b/lib/Lower/PFTBuilder.cpp
index 349f76e..8dfc8f7 100644
--- a/lib/Lower/PFTBuilder.cpp
+++ b/lib/Lower/PFTBuilder.cpp
@@ -7,17 +7,28 @@
//===----------------------------------------------------------------------===//
#include "flang/Lower/PFTBuilder.h"
-#include "flang/Lower/Utils.h"
+#include "IntervalSet.h"
+#include "flang/Lower/Support/Utils.h"
#include "flang/Parser/dump-parse-tree.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/tools.h"
+#include "llvm/ADT/DenseSet.h"
+#include "llvm/ADT/IntervalMap.h"
#include "llvm/Support/CommandLine.h"
+#define DEBUG_TYPE "flang-pft"
+
static llvm::cl::opt<bool> clDisableStructuredFir(
"no-structured-fir", llvm::cl::desc("disable generation of structured FIR"),
llvm::cl::init(false), llvm::cl::Hidden);
+static llvm::cl::opt<bool> nonRecursiveProcedures(
+ "non-recursive-procedures",
+ llvm::cl::desc("Make procedures non-recursive by default. This was the "
+ "default for all Fortran standards prior to 2018."),
+ llvm::cl::init(/*2018 standard=*/false));
+
using namespace Fortran;
namespace {
@@ -66,8 +77,8 @@
PFTBuilder(const semantics::SemanticsContext &semanticsContext)
: pgm{std::make_unique<lower::pft::Program>()}, semanticsContext{
semanticsContext} {
- lower::pft::ParentVariant parent{*pgm.get()};
- parentVariantStack.push_back(parent);
+ lower::pft::PftNode pftRoot{*pgm.get()};
+ pftParentStack.push_back(pftRoot);
}
/// Get the result
@@ -83,24 +94,65 @@
} else if constexpr (UnwrapStmt<A>::isStmt) {
using T = typename UnwrapStmt<A>::Type;
// Node "a" being visited has one of the following types:
- // Statement<T>, Statement<Indirection<T>, UnlabeledStatement<T>,
+ // Statement<T>, Statement<Indirection<T>>, UnlabeledStatement<T>,
// or UnlabeledStatement<Indirection<T>>
auto stmt{UnwrapStmt<A>(a)};
if constexpr (lower::pft::isConstructStmt<T> ||
lower::pft::isOtherStmt<T>) {
- addEvaluation(lower::pft::Evaluation{stmt.unwrapped,
- parentVariantStack.back(),
- stmt.position, stmt.label});
+ addEvaluation(lower::pft::Evaluation{
+ stmt.unwrapped, pftParentStack.back(), stmt.position, stmt.label});
return false;
} else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
- addEvaluation(
- makeEvaluationAction(stmt.unwrapped, stmt.position, stmt.label));
- return true;
+ return std::visit(
+ common::visitors{
+ [&](const common::Indirection<parser::IfStmt> &x) {
+ convertIfStmt(x.value(), stmt.position, stmt.label);
+ return false;
+ },
+ [&](const auto &x) {
+ addEvaluation(lower::pft::Evaluation{
+ removeIndirection(x), pftParentStack.back(),
+ stmt.position, stmt.label});
+ return true;
+ },
+ },
+ stmt.unwrapped.u);
}
}
return true;
}
+ /// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
+ /// first statement of the construct.
+ void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position,
+ std::optional<parser::Label> label) {
+ // Generate a skeleton IfConstruct parse node. Its components are never
+ // referenced. The actual components are available via the IfConstruct
+ // evaluation's nested evaluationList, with the ifStmt in the position of
+ // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference
+ // front end generated parse nodes; this is an exceptional case.
+ static const auto ifConstruct = parser::IfConstruct{
+ parser::Statement<parser::IfThenStmt>{
+ std::nullopt,
+ parser::IfThenStmt{
+ std::optional<parser::Name>{},
+ parser::ScalarLogicalExpr{parser::LogicalExpr{parser::Expr{
+ parser::LiteralConstant{parser::LogicalLiteralConstant{
+ false, std::optional<parser::KindParam>{}}}}}}}},
+ parser::Block{}, std::list<parser::IfConstruct::ElseIfBlock>{},
+ std::optional<parser::IfConstruct::ElseBlock>{},
+ parser::Statement<parser::EndIfStmt>{std::nullopt,
+ parser::EndIfStmt{std::nullopt}}};
+ enterConstructOrDirective(ifConstruct);
+ addEvaluation(
+ lower::pft::Evaluation{ifStmt, pftParentStack.back(), position, label});
+ Pre(std::get<parser::UnlabeledStatement<parser::ActionStmt>>(ifStmt.t));
+ static const auto endIfStmt = parser::EndIfStmt{std::nullopt};
+ addEvaluation(
+ lower::pft::Evaluation{endIfStmt, pftParentStack.back(), {}, {}});
+ exitConstructOrDirective();
+ }
+
template <typename A>
constexpr void Post(const A &) {
if constexpr (lower::pft::isFunctionLike<A>) {
@@ -120,25 +172,16 @@
// Block data
bool Pre(const parser::BlockData &node) {
- addUnit(lower::pft::BlockDataUnit{node, parentVariantStack.back()});
+ addUnit(lower::pft::BlockDataUnit{node, pftParentStack.back(),
+ semanticsContext});
return false;
}
// Get rid of production wrapper
- bool Pre(const parser::UnlabeledStatement<parser::ForallAssignmentStmt>
- &statement) {
- addEvaluation(std::visit(
- [&](const auto &x) {
- return lower::pft::Evaluation{
- x, parentVariantStack.back(), statement.source, {}};
- },
- statement.statement.u));
- return false;
- }
bool Pre(const parser::Statement<parser::ForallAssignmentStmt> &statement) {
addEvaluation(std::visit(
[&](const auto &x) {
- return lower::pft::Evaluation{x, parentVariantStack.back(),
+ return lower::pft::Evaluation{x, pftParentStack.back(),
statement.source, statement.label};
},
statement.statement.u));
@@ -151,7 +194,7 @@
// Not caught as other AssignmentStmt because it is not
// wrapped in a parser::ActionStmt.
addEvaluation(lower::pft::Evaluation{stmt.statement,
- parentVariantStack.back(),
+ pftParentStack.back(),
stmt.source, stmt.label});
return false;
},
@@ -160,30 +203,69 @@
whereBody.u);
}
+ // CompilerDirective have special handling in case they are top level
+ // directives (i.e. they do not belong to a ProgramUnit).
+ bool Pre(const parser::CompilerDirective &directive) {
+ assert(pftParentStack.size() > 0 &&
+ "At least the Program must be a parent");
+ if (pftParentStack.back().isA<lower::pft::Program>()) {
+ addUnit(
+ lower::pft::CompilerDirectiveUnit(directive, pftParentStack.back()));
+ return false;
+ }
+ return enterConstructOrDirective(directive);
+ }
+
private:
/// Initialize a new module-like unit and make it the builder's focus.
template <typename A>
bool enterModule(const A &func) {
auto &unit =
- addUnit(lower::pft::ModuleLikeUnit{func, parentVariantStack.back()});
+ addUnit(lower::pft::ModuleLikeUnit{func, pftParentStack.back()});
functionList = &unit.nestedFunctions;
- parentVariantStack.emplace_back(unit);
+ pftParentStack.emplace_back(unit);
return true;
}
void exitModule() {
- parentVariantStack.pop_back();
+ pftParentStack.pop_back();
resetFunctionState();
}
- /// Ensure that a function has a branch target after the last user statement.
+ /// Add the end statement Evaluation of a sub/program to the PFT.
+ /// There may be intervening internal subprogram definitions between
+ /// prior statements and this end statement.
void endFunctionBody() {
- if (lastLexicalEvaluation) {
- static const parser::ContinueStmt endTarget{};
- addEvaluation(
- lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
- lastLexicalEvaluation = nullptr;
+ if (evaluationListStack.empty())
+ return;
+ auto evaluationList = evaluationListStack.back();
+ if (evaluationList->empty() || !evaluationList->back().isEndStmt()) {
+ const auto &endStmt =
+ pftParentStack.back().get<lower::pft::FunctionLikeUnit>().endStmt;
+ endStmt.visit(common::visitors{
+ [&](const parser::Statement<parser::EndProgramStmt> &s) {
+ addEvaluation(lower::pft::Evaluation{
+ s.statement, pftParentStack.back(), s.source, s.label});
+ },
+ [&](const parser::Statement<parser::EndFunctionStmt> &s) {
+ addEvaluation(lower::pft::Evaluation{
+ s.statement, pftParentStack.back(), s.source, s.label});
+ },
+ [&](const parser::Statement<parser::EndSubroutineStmt> &s) {
+ addEvaluation(lower::pft::Evaluation{
+ s.statement, pftParentStack.back(), s.source, s.label});
+ },
+ [&](const parser::Statement<parser::EndMpSubprogramStmt> &s) {
+ addEvaluation(lower::pft::Evaluation{
+ s.statement, pftParentStack.back(), s.source, s.label});
+ },
+ [&](const auto &s) {
+ llvm::report_fatal_error("missing end statement or unexpected "
+ "begin statement reference");
+ },
+ });
}
+ lastLexicalEvaluation = nullptr;
}
/// Initialize a new function-like unit and make it the builder's focus.
@@ -192,47 +274,50 @@
const semantics::SemanticsContext &semanticsContext) {
endFunctionBody(); // enclosing host subprogram body, if any
auto &unit = addFunction(lower::pft::FunctionLikeUnit{
- func, parentVariantStack.back(), semanticsContext});
+ func, pftParentStack.back(), semanticsContext});
labelEvaluationMap = &unit.labelEvaluationMap;
assignSymbolLabelMap = &unit.assignSymbolLabelMap;
functionList = &unit.nestedFunctions;
pushEvaluationList(&unit.evaluationList);
- parentVariantStack.emplace_back(unit);
+ pftParentStack.emplace_back(unit);
return true;
}
void exitFunction() {
+ rewriteIfGotos();
endFunctionBody();
analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links
+ processEntryPoints();
popEvaluationList();
labelEvaluationMap = nullptr;
assignSymbolLabelMap = nullptr;
- parentVariantStack.pop_back();
+ pftParentStack.pop_back();
resetFunctionState();
}
/// Initialize a new construct and make it the builder's focus.
template <typename A>
bool enterConstructOrDirective(const A &construct) {
- auto &eval = addEvaluation(
- lower::pft::Evaluation{construct, parentVariantStack.back()});
+ auto &eval =
+ addEvaluation(lower::pft::Evaluation{construct, pftParentStack.back()});
eval.evaluationList.reset(new lower::pft::EvaluationList);
pushEvaluationList(eval.evaluationList.get());
- parentVariantStack.emplace_back(eval);
+ pftParentStack.emplace_back(eval);
constructAndDirectiveStack.emplace_back(&eval);
return true;
}
void exitConstructOrDirective() {
+ rewriteIfGotos();
popEvaluationList();
- parentVariantStack.pop_back();
+ pftParentStack.pop_back();
constructAndDirectiveStack.pop_back();
}
/// Reset function state to that of an enclosing host function.
void resetFunctionState() {
- if (!parentVariantStack.empty()) {
- parentVariantStack.back().visit(common::visitors{
+ if (!pftParentStack.empty()) {
+ pftParentStack.back().visit(common::visitors{
[&](lower::pft::FunctionLikeUnit &p) {
functionList = &p.nestedFunctions;
labelEvaluationMap = &p.labelEvaluationMap;
@@ -270,9 +355,8 @@
return std::visit(
common::visitors{
[&](const auto &x) {
- return lower::pft::Evaluation{removeIndirection(x),
- parentVariantStack.back(), position,
- label};
+ return lower::pft::Evaluation{
+ removeIndirection(x), pftParentStack.back(), position, label};
},
},
statement.u);
@@ -281,13 +365,13 @@
/// Append an Evaluation to the end of the current list.
lower::pft::Evaluation &addEvaluation(lower::pft::Evaluation &&eval) {
assert(functionList && "not in a function");
- assert(evaluationListStack.size() > 0);
- if (constructAndDirectiveStack.size() > 0) {
+ assert(!evaluationListStack.empty() && "empty evaluation list stack");
+ if (!constructAndDirectiveStack.empty())
eval.parentConstruct = constructAndDirectiveStack.back();
- }
+ auto &entryPointList = eval.getOwningProcedure()->entryPointList;
evaluationListStack.back()->emplace_back(std::move(eval));
lower::pft::Evaluation *p = &evaluationListStack.back()->back();
- if (p->isActionStmt() || p->isConstructStmt()) {
+ if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt()) {
if (lastLexicalEvaluation) {
lastLexicalEvaluation->lexicalSuccessor = p;
p->printIndex = lastLexicalEvaluation->printIndex + 1;
@@ -295,18 +379,28 @@
p->printIndex = 1;
}
lastLexicalEvaluation = p;
+ for (auto entryIndex = entryPointList.size() - 1;
+ entryIndex && !entryPointList[entryIndex].second->lexicalSuccessor;
+ --entryIndex)
+ // Link to the entry's first executable statement.
+ entryPointList[entryIndex].second->lexicalSuccessor = p;
+ } else if (const auto *entryStmt = p->getIf<parser::EntryStmt>()) {
+ const auto *sym = std::get<parser::Name>(entryStmt->t).symbol;
+ assert(sym->has<semantics::SubprogramDetails>() &&
+ "entry must be a subprogram");
+ entryPointList.push_back(std::pair{sym, p});
}
- if (p->label.has_value()) {
+ if (p->label.has_value())
labelEvaluationMap->try_emplace(*p->label, p);
- }
return evaluationListStack.back()->back();
}
/// push a new list on the stack of Evaluation lists
- void pushEvaluationList(lower::pft::EvaluationList *eval) {
+ void pushEvaluationList(lower::pft::EvaluationList *evaluationList) {
assert(functionList && "not in a function");
- assert(eval && eval->empty() && "evaluation list isn't correct");
- evaluationListStack.emplace_back(eval);
+ assert(evaluationList && evaluationList->empty() &&
+ "evaluation list isn't correct");
+ evaluationListStack.emplace_back(evaluationList);
}
/// pop the current list and return to the last Evaluation list
@@ -315,25 +409,119 @@
evaluationListStack.pop_back();
}
+ /// Rewrite IfConstructs containing a GotoStmt to eliminate an unstructured
+ /// branch and a trivial basic block. The pre-branch-analysis code:
+ ///
+ /// <<IfConstruct>>
+ /// 1 If[Then]Stmt: if(cond) goto L
+ /// 2 GotoStmt: goto L
+ /// 3 EndIfStmt
+ /// <<End IfConstruct>>
+ /// 4 Statement: ...
+ /// 5 Statement: ...
+ /// 6 Statement: L ...
+ ///
+ /// becomes:
+ ///
+ /// <<IfConstruct>>
+ /// 1 If[Then]Stmt [negate]: if(cond) goto L
+ /// 4 Statement: ...
+ /// 5 Statement: ...
+ /// 3 EndIfStmt
+ /// <<End IfConstruct>>
+ /// 6 Statement: L ...
+ ///
+ /// The If[Then]Stmt condition is implicitly negated. It is not modified
+ /// in the PFT. It must be negated when generating FIR. The GotoStmt is
+ /// deleted.
+ ///
+ /// The transformation is only valid for forward branch targets at the same
+ /// construct nesting level as the IfConstruct. The result must not violate
+ /// construct nesting requirements or contain an EntryStmt. The result
+ /// is subject to normal un/structured code classification analysis. The
+ /// result is allowed to violate the F18 Clause 11.1.2.1 prohibition on
+ /// transfer of control into the interior of a construct block, as that does
+ /// not compromise correct code generation. When two transformation
+ /// candidates overlap, at least one must be disallowed. In such cases,
+ /// the current heuristic favors simple code generation, which happens to
+ /// favor later candidates over earlier candidates. That choice is probably
+ /// not significant, but could be changed.
+ ///
+ void rewriteIfGotos() {
+ using T = struct {
+ lower::pft::EvaluationList::iterator ifConstructIt;
+ parser::Label ifTargetLabel;
+ };
+ llvm::SmallVector<T, 8> ifExpansionStack;
+ auto &evaluationList = *evaluationListStack.back();
+ for (auto it = evaluationList.begin(), end = evaluationList.end();
+ it != end; ++it) {
+ auto &eval = *it;
+ if (eval.isA<parser::EntryStmt>()) {
+ ifExpansionStack.clear();
+ continue;
+ }
+ auto firstStmt = [](lower::pft::Evaluation *e) {
+ return e->isConstruct() ? &*e->evaluationList->begin() : e;
+ };
+ auto &targetEval = *firstStmt(&eval);
+ if (targetEval.label) {
+ while (!ifExpansionStack.empty() &&
+ ifExpansionStack.back().ifTargetLabel == *targetEval.label) {
+ auto ifConstructIt = ifExpansionStack.back().ifConstructIt;
+ auto successorIt = std::next(ifConstructIt);
+ if (successorIt != it) {
+ auto &ifBodyList = *ifConstructIt->evaluationList;
+ auto gotoStmtIt = std::next(ifBodyList.begin());
+ assert(gotoStmtIt->isA<parser::GotoStmt>() && "expected GotoStmt");
+ ifBodyList.erase(gotoStmtIt);
+ auto &ifStmt = *ifBodyList.begin();
+ ifStmt.negateCondition = true;
+ ifStmt.lexicalSuccessor = firstStmt(&*successorIt);
+ auto endIfStmtIt = std::prev(ifBodyList.end());
+ std::prev(it)->lexicalSuccessor = &*endIfStmtIt;
+ endIfStmtIt->lexicalSuccessor = firstStmt(&*it);
+ ifBodyList.splice(endIfStmtIt, evaluationList, successorIt, it);
+ for (; successorIt != endIfStmtIt; ++successorIt)
+ successorIt->parentConstruct = &*ifConstructIt;
+ }
+ ifExpansionStack.pop_back();
+ }
+ }
+ if (eval.isA<parser::IfConstruct>() && eval.evaluationList->size() == 3) {
+ if (auto *gotoStmt = std::next(eval.evaluationList->begin())
+ ->getIf<parser::GotoStmt>())
+ ifExpansionStack.push_back({it, gotoStmt->v});
+ }
+ }
+ }
+
/// Mark I/O statement ERR, EOR, and END specifier branch targets.
+ /// Mark an I/O statement with an assigned format as unstructured.
template <typename A>
void analyzeIoBranches(lower::pft::Evaluation &eval, const A &stmt) {
- auto processIfLabel{[&](const auto &specs) {
- using LabelNodes =
- std::tuple<parser::ErrLabel, parser::EorLabel, parser::EndLabel>;
- for (const auto &spec : specs) {
- const auto *label = std::visit(
- [](const auto &label) -> const parser::Label * {
- using B = std::decay_t<decltype(label)>;
- if constexpr (common::HasMember<B, LabelNodes>) {
- return &label.v;
- }
- return nullptr;
- },
+ auto analyzeFormatSpec = [&](const parser::Format &format) {
+ if (const auto *expr = std::get_if<parser::Expr>(&format.u)) {
+ if (semantics::ExprHasTypeCategory(*semantics::GetExpr(*expr),
+ common::TypeCategory::Integer))
+ eval.isUnstructured = true;
+ }
+ };
+ auto analyzeSpecs{[&](const auto &specList) {
+ for (const auto &spec : specList) {
+ std::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::parser::Format &format) {
+ analyzeFormatSpec(format);
+ },
+ [&](const auto &label) {
+ using LabelNodes =
+ std::tuple<parser::ErrLabel, parser::EorLabel,
+ parser::EndLabel>;
+ if constexpr (common::HasMember<decltype(label), LabelNodes>)
+ markBranchTarget(eval, label.v);
+ }},
spec.u);
-
- if (label)
- markBranchTarget(eval, *label);
}
}};
@@ -344,11 +532,17 @@
if constexpr (std::is_same_v<A, parser::ReadStmt> ||
std::is_same_v<A, parser::WriteStmt>) {
- processIfLabel(stmt.controls);
+ if (stmt.format)
+ analyzeFormatSpec(*stmt.format);
+ analyzeSpecs(stmt.controls);
+ } else if constexpr (std::is_same_v<A, parser::PrintStmt>) {
+ analyzeFormatSpec(std::get<parser::Format>(stmt.t));
} else if constexpr (std::is_same_v<A, parser::InquireStmt>) {
- processIfLabel(std::get<std::list<parser::InquireSpec>>(stmt.u));
+ if (const auto *specList =
+ std::get_if<std::list<parser::InquireSpec>>(&stmt.u))
+ analyzeSpecs(*specList);
} else if constexpr (common::HasMember<A, OtherIOStmts>) {
- processIfLabel(stmt.v);
+ analyzeSpecs(stmt.v);
} else {
// Always crash if this is instantiated
static_assert(!std::is_same_v<A, parser::ReadStmt>,
@@ -365,16 +559,15 @@
void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
lower::pft::Evaluation &targetEvaluation) {
sourceEvaluation.isUnstructured = true;
- if (!sourceEvaluation.controlSuccessor) {
+ if (!sourceEvaluation.controlSuccessor)
sourceEvaluation.controlSuccessor = &targetEvaluation;
- }
targetEvaluation.isNewBlock = true;
// If this is a branch into the body of a construct (usually illegal,
// but allowed in some legacy cases), then the targetEvaluation and its
// ancestors must be marked as unstructured.
auto *sourceConstruct = sourceEvaluation.parentConstruct;
auto *targetConstruct = targetEvaluation.parentConstruct;
- if (targetEvaluation.isConstructStmt() &&
+ if (targetConstruct &&
&targetConstruct->getFirstNestedEvaluation() == &targetEvaluation)
// A branch to an initial constructStmt is a branch to the construct.
targetConstruct = targetConstruct->parentConstruct;
@@ -423,16 +616,15 @@
parser::TypeGuardStmt, parser::WhereConstructStmt>;
if constexpr (common::HasMember<A, MaybeConstructNameInTuple>) {
- if (auto name{std::get<std::optional<parser::Name>>(stmt.t)})
+ if (auto name = std::get<std::optional<parser::Name>>(stmt.t))
return name->ToString();
}
// These statements have several std::optional<parser::Name>
if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
std::is_same_v<A, parser::SelectTypeStmt>) {
- if (auto name{std::get<0>(stmt.t)}) {
+ if (auto name = std::get<0>(stmt.t))
return name->ToString();
- }
}
return {};
}
@@ -442,10 +634,9 @@
template <typename A>
void insertConstructName(const A &stmt,
lower::pft::Evaluation *parentConstruct) {
- std::string name{getConstructName(stmt)};
- if (!name.empty()) {
+ std::string name = getConstructName(stmt);
+ if (!name.empty())
constructNameMap[name] = parentConstruct;
- }
}
/// Insert branch links for a list of Evaluations.
@@ -453,24 +644,23 @@
/// top-level statements of a program.
void analyzeBranches(lower::pft::Evaluation *parentConstruct,
std::list<lower::pft::Evaluation> &evaluationList) {
- lower::pft::Evaluation *lastConstructStmtEvaluation{nullptr};
- lower::pft::Evaluation *lastIfStmtEvaluation{nullptr};
+ lower::pft::Evaluation *lastConstructStmtEvaluation{};
for (auto &eval : evaluationList) {
eval.visit(common::visitors{
- // Action statements
+ // Action statements (except I/O statements)
[&](const parser::CallStmt &s) {
// Look for alternate return specifiers.
- const auto &args{std::get<std::list<parser::ActualArgSpec>>(s.v.t)};
+ const auto &args =
+ std::get<std::list<parser::ActualArgSpec>>(s.v.t);
for (const auto &arg : args) {
- const auto &actual{std::get<parser::ActualArg>(arg.t)};
- if (const auto *altReturn{
- std::get_if<parser::AltReturnSpec>(&actual.u)}) {
+ const auto &actual = std::get<parser::ActualArg>(arg.t);
+ if (const auto *altReturn =
+ std::get_if<parser::AltReturnSpec>(&actual.u))
markBranchTarget(eval, altReturn->v);
- }
}
},
[&](const parser::CycleStmt &s) {
- std::string name{getConstructName(s)};
+ std::string name = getConstructName(s);
lower::pft::Evaluation *construct{name.empty()
? doConstructStack.back()
: constructNameMap[name]};
@@ -478,7 +668,7 @@
markBranchTarget(eval, construct->evaluationList->back());
},
[&](const parser::ExitStmt &s) {
- std::string name{getConstructName(s)};
+ std::string name = getConstructName(s);
lower::pft::Evaluation *construct{name.empty()
? doConstructStack.back()
: constructNameMap[name]};
@@ -486,7 +676,10 @@
markBranchTarget(eval, *construct->constructExit);
},
[&](const parser::GotoStmt &s) { markBranchTarget(eval, s.v); },
- [&](const parser::IfStmt &) { lastIfStmtEvaluation = &eval; },
+ [&](const parser::IfStmt &) {
+ eval.lexicalSuccessor->isNewBlock = true;
+ lastConstructStmtEvaluation = &eval;
+ },
[&](const parser::ReturnStmt &) {
eval.isUnstructured = true;
if (eval.lexicalSuccessor->lexicalSuccessor)
@@ -498,20 +691,13 @@
markSuccessorAsNewBlock(eval);
},
[&](const parser::ComputedGotoStmt &s) {
- for (auto &label : std::get<std::list<parser::Label>>(s.t)) {
+ for (auto &label : std::get<std::list<parser::Label>>(s.t))
markBranchTarget(eval, label);
- }
},
[&](const parser::ArithmeticIfStmt &s) {
markBranchTarget(eval, std::get<1>(s.t));
markBranchTarget(eval, std::get<2>(s.t));
markBranchTarget(eval, std::get<3>(s.t));
- if (semantics::ExprHasTypeCategory(
- *semantics::GetExpr(std::get<parser::Expr>(s.t)),
- common::TypeCategory::Real)) {
- // Real expression evaluation uses an additional local block.
- eval.localBlocks.emplace_back(nullptr);
- }
},
[&](const parser::AssignStmt &s) { // legacy label assignment
auto &label = std::get<parser::Label>(s.t);
@@ -520,9 +706,8 @@
lower::pft::Evaluation *target{
labelEvaluationMap->find(label)->second};
assert(target && "missing branch target evaluation");
- if (!target->isA<parser::FormatStmt>()) {
+ if (!target->isA<parser::FormatStmt>())
target->isNewBlock = true;
- }
auto iter = assignSymbolLabelMap->find(*sym);
if (iter == assignSymbolLabelMap->end()) {
lower::pft::LabelSet labelSet{};
@@ -569,60 +754,47 @@
[&](const parser::NonLabelDoStmt &s) {
insertConstructName(s, parentConstruct);
doConstructStack.push_back(parentConstruct);
- auto &control{std::get<std::optional<parser::LoopControl>>(s.t)};
- // eval.block is the loop preheader block, which will be set
- // elsewhere if the NonLabelDoStmt is itself a target.
- // eval.localBlocks[0] is the loop header block.
- eval.localBlocks.emplace_back(nullptr);
- if (!control.has_value()) {
+ const auto &loopControl =
+ std::get<std::optional<parser::LoopControl>>(s.t);
+ if (!loopControl.has_value()) {
eval.isUnstructured = true; // infinite loop
return;
}
eval.nonNopSuccessor().isNewBlock = true;
eval.controlSuccessor = &evaluationList.back();
- if (std::holds_alternative<parser::ScalarLogicalExpr>(control->u)) {
+ if (const auto *bounds =
+ std::get_if<parser::LoopControl::Bounds>(&loopControl->u)) {
+ if (bounds->name.thing.symbol->GetType()->IsNumeric(
+ common::TypeCategory::Real))
+ eval.isUnstructured = true; // real-valued loop control
+ } else if (std::get_if<parser::ScalarLogicalExpr>(
+ &loopControl->u)) {
eval.isUnstructured = true; // while loop
}
- // Defer additional processing for an unstructured concurrent loop
- // to the EndDoStmt, when the loop is known to be unstructured.
},
[&](const parser::EndDoStmt &) {
- lower::pft::Evaluation &doEval{evaluationList.front()};
+ lower::pft::Evaluation &doEval = evaluationList.front();
eval.controlSuccessor = &doEval;
doConstructStack.pop_back();
- if (parentConstruct->lowerAsStructured()) {
+ if (parentConstruct->lowerAsStructured())
return;
- }
- // Now that the loop is known to be unstructured, finish concurrent
- // loop processing, using NonLabelDoStmt information.
+ // The loop is unstructured, which wasn't known for all cases when
+ // visiting the NonLabelDoStmt.
parentConstruct->constructExit->isNewBlock = true;
- const auto &doStmt{doEval.getIf<parser::NonLabelDoStmt>()};
- assert(doStmt && "missing NonLabelDoStmt");
- auto &control{
- std::get<std::optional<parser::LoopControl>>(doStmt->t)};
- if (!control.has_value()) {
+ const auto &doStmt = *doEval.getIf<parser::NonLabelDoStmt>();
+ const auto &loopControl =
+ std::get<std::optional<parser::LoopControl>>(doStmt.t);
+ if (!loopControl.has_value())
return; // infinite loop
- }
- const auto *concurrent{
- std::get_if<parser::LoopControl::Concurrent>(&control->u)};
- if (!concurrent) {
- return;
- }
- // Unstructured concurrent loop. NonLabelDoStmt code accounts
- // for one concurrent loop dimension. Reserve preheader,
- // header, and latch blocks for the remaining dimensions, and
- // one block for a mask expression.
- const auto &header{
- std::get<parser::ConcurrentHeader>(concurrent->t)};
- auto dims{std::get<std::list<parser::ConcurrentControl>>(header.t)
- .size()};
- for (; dims > 1; --dims) {
- doEval.localBlocks.emplace_back(nullptr); // preheader
- doEval.localBlocks.emplace_back(nullptr); // header
- eval.localBlocks.emplace_back(nullptr); // latch
- }
- if (std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)) {
- doEval.localBlocks.emplace_back(nullptr); // mask
+ if (const auto *concurrent =
+ std::get_if<parser::LoopControl::Concurrent>(
+ &loopControl->u)) {
+ // If there is a mask, the EndDoStmt starts a new block.
+ const auto &header =
+ std::get<parser::ConcurrentHeader>(concurrent->t);
+ eval.isNewBlock |=
+ std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)
+ .has_value();
}
},
[&](const parser::IfThenStmt &s) {
@@ -642,9 +814,8 @@
lastConstructStmtEvaluation = nullptr;
},
[&](const parser::EndIfStmt &) {
- if (parentConstruct->lowerAsUnstructured()) {
+ if (parentConstruct->lowerAsUnstructured())
parentConstruct->constructExit->isNewBlock = true;
- }
if (lastConstructStmtEvaluation) {
lastConstructStmtEvaluation->controlSuccessor =
parentConstruct->constructExit;
@@ -689,37 +860,22 @@
eval.isUnstructured = true;
},
+ // Default - Common analysis for I/O statements; otherwise nop.
[&](const auto &stmt) {
using A = std::decay_t<decltype(stmt)>;
- using IoStmts = std::tuple<parser::BackspaceStmt, parser::CloseStmt,
- parser::EndfileStmt, parser::FlushStmt,
- parser::InquireStmt, parser::OpenStmt,
- parser::ReadStmt, parser::RewindStmt,
- parser::WaitStmt, parser::WriteStmt>;
- if constexpr (common::HasMember<A, IoStmts>) {
+ using IoStmts = std::tuple<
+ parser::BackspaceStmt, parser::CloseStmt, parser::EndfileStmt,
+ parser::FlushStmt, parser::InquireStmt, parser::OpenStmt,
+ parser::PrintStmt, parser::ReadStmt, parser::RewindStmt,
+ parser::WaitStmt, parser::WriteStmt>;
+ if constexpr (common::HasMember<A, IoStmts>)
analyzeIoBranches(eval, stmt);
- }
-
- /* do nothing */
},
});
// Analyze construct evaluations.
- if (eval.evaluationList) {
+ if (eval.evaluationList)
analyzeBranches(&eval, *eval.evaluationList);
- }
-
- // Insert branch links for an unstructured IF statement.
- if (lastIfStmtEvaluation && lastIfStmtEvaluation != &eval) {
- // eval is the action substatement of an IfStmt.
- if (eval.lowerAsUnstructured()) {
- eval.isNewBlock = true;
- markSuccessorAsNewBlock(eval);
- lastIfStmtEvaluation->isUnstructured = true;
- }
- lastIfStmtEvaluation->controlSuccessor = &eval.nonNopSuccessor();
- lastIfStmtEvaluation = nullptr;
- }
// Set the successor of the last statement in an IF or SELECT block.
if (!eval.controlSuccessor && eval.lexicalSuccessor &&
@@ -729,141 +885,184 @@
}
// Propagate isUnstructured flag to enclosing construct.
- if (parentConstruct && eval.isUnstructured) {
+ if (parentConstruct && eval.isUnstructured)
parentConstruct->isUnstructured = true;
- }
// The successor of a branch starts a new block.
if (eval.controlSuccessor && eval.isActionStmt() &&
- eval.lowerAsUnstructured()) {
+ eval.lowerAsUnstructured())
markSuccessorAsNewBlock(eval);
- }
}
}
+ /// For multiple entry subprograms, build a list of the dummy arguments that
+ /// appear in some, but not all entry points. For those that are functions,
+ /// also find one of the largest function results, since a single result
+ /// container holds the result for all entries.
+ void processEntryPoints() {
+ auto *unit = evaluationListStack.back()->front().getOwningProcedure();
+ int entryCount = unit->entryPointList.size();
+ if (entryCount == 1)
+ return;
+ llvm::DenseMap<semantics::Symbol *, int> dummyCountMap;
+ for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) {
+ unit->setActiveEntry(entryIndex);
+ const auto &details =
+ unit->getSubprogramSymbol().get<semantics::SubprogramDetails>();
+ for (auto *arg : details.dummyArgs()) {
+ if (!arg)
+ continue; // alternate return specifier (no actual argument)
+ const auto iter = dummyCountMap.find(arg);
+ if (iter == dummyCountMap.end())
+ dummyCountMap.try_emplace(arg, 1);
+ else
+ ++iter->second;
+ }
+ if (details.isFunction()) {
+ const auto *resultSym = &details.result();
+ assert(resultSym && "missing result symbol");
+ if (!unit->primaryResult ||
+ unit->primaryResult->size() < resultSym->size())
+ unit->primaryResult = resultSym;
+ }
+ }
+ unit->setActiveEntry(0);
+ for (auto arg : dummyCountMap)
+ if (arg.second < entryCount)
+ unit->nonUniversalDummyArguments.push_back(arg.first);
+ }
+
std::unique_ptr<lower::pft::Program> pgm;
- std::vector<lower::pft::ParentVariant> parentVariantStack;
+ std::vector<lower::pft::PftNode> pftParentStack;
const semantics::SemanticsContext &semanticsContext;
/// functionList points to the internal or module procedure function list
/// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null.
- std::list<lower::pft::FunctionLikeUnit> *functionList{nullptr};
+ std::list<lower::pft::FunctionLikeUnit> *functionList{};
std::vector<lower::pft::Evaluation *> constructAndDirectiveStack{};
std::vector<lower::pft::Evaluation *> doConstructStack{};
/// evaluationListStack is the current nested construct evaluationList state.
std::vector<lower::pft::EvaluationList *> evaluationListStack{};
- llvm::DenseMap<parser::Label, lower::pft::Evaluation *> *labelEvaluationMap{
- nullptr};
- lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr};
+ llvm::DenseMap<parser::Label, lower::pft::Evaluation *> *labelEvaluationMap{};
+ lower::pft::SymbolLabelMap *assignSymbolLabelMap{};
std::map<std::string, lower::pft::Evaluation *> constructNameMap{};
- lower::pft::Evaluation *lastLexicalEvaluation{nullptr};
+ lower::pft::Evaluation *lastLexicalEvaluation{};
};
class PFTDumper {
public:
- void dumpPFT(llvm::raw_ostream &outputStream, lower::pft::Program &pft) {
+ void dumpPFT(llvm::raw_ostream &outputStream,
+ const lower::pft::Program &pft) {
for (auto &unit : pft.getUnits()) {
std::visit(common::visitors{
- [&](lower::pft::BlockDataUnit &unit) {
+ [&](const lower::pft::BlockDataUnit &unit) {
outputStream << getNodeIndex(unit) << " ";
outputStream << "BlockData: ";
- outputStream << "\nEndBlockData\n\n";
+ outputStream << "\nEnd BlockData\n\n";
},
- [&](lower::pft::FunctionLikeUnit &func) {
+ [&](const lower::pft::FunctionLikeUnit &func) {
dumpFunctionLikeUnit(outputStream, func);
},
- [&](lower::pft::ModuleLikeUnit &unit) {
+ [&](const lower::pft::ModuleLikeUnit &unit) {
dumpModuleLikeUnit(outputStream, unit);
},
+ [&](const lower::pft::CompilerDirectiveUnit &unit) {
+ dumpCompilerDirectiveUnit(outputStream, unit);
+ },
},
unit);
}
}
- llvm::StringRef evaluationName(lower::pft::Evaluation &eval) {
- return eval.visit(common::visitors{
- [](const auto &parseTreeNode) {
- return parser::ParseTreeDumper::GetNodeName(parseTreeNode);
- },
+ llvm::StringRef evaluationName(const lower::pft::Evaluation &eval) {
+ return eval.visit([](const auto &parseTreeNode) {
+ return parser::ParseTreeDumper::GetNodeName(parseTreeNode);
});
}
- void dumpEvaluationList(llvm::raw_ostream &outputStream,
- lower::pft::EvaluationList &evaluationList,
- int indent = 1) {
- static const std::string white{" ++"};
- std::string indentString{white.substr(0, indent * 2)};
- for (lower::pft::Evaluation &eval : evaluationList) {
- llvm::StringRef name{evaluationName(eval)};
- std::string bang{eval.isUnstructured ? "!" : ""};
- if (eval.isConstruct() || eval.isDirective()) {
- outputStream << indentString << "<<" << name << bang << ">>";
- if (eval.constructExit) {
- outputStream << " -> " << eval.constructExit->printIndex;
- }
- outputStream << '\n';
- dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
- outputStream << indentString << "<<End " << name << bang << ">>\n";
- continue;
- }
- outputStream << indentString;
- if (eval.printIndex) {
- outputStream << eval.printIndex << ' ';
- }
- if (eval.isNewBlock) {
- outputStream << '^';
- }
- if (eval.localBlocks.size()) {
- outputStream << '*';
- }
- outputStream << name << bang;
- if (eval.isActionStmt() || eval.isConstructStmt()) {
- if (eval.controlSuccessor) {
- outputStream << " -> " << eval.controlSuccessor->printIndex;
- }
- }
- if (eval.position.size()) {
- outputStream << ": " << eval.position.ToString();
- }
+ void dumpEvaluation(llvm::raw_ostream &outputStream,
+ const lower::pft::Evaluation &eval,
+ const std::string &indentString, int indent = 1) {
+ llvm::StringRef name = evaluationName(eval);
+ std::string bang = eval.isUnstructured ? "!" : "";
+ if (eval.isConstruct() || eval.isDirective()) {
+ outputStream << indentString << "<<" << name << bang << ">>";
+ if (eval.constructExit)
+ outputStream << " -> " << eval.constructExit->printIndex;
outputStream << '\n';
+ dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
+ outputStream << indentString << "<<End " << name << bang << ">>\n";
+ return;
}
+ outputStream << indentString;
+ if (eval.printIndex)
+ outputStream << eval.printIndex << ' ';
+ if (eval.isNewBlock)
+ outputStream << '^';
+ outputStream << name << bang;
+ if (eval.isActionStmt() || eval.isConstructStmt()) {
+ if (eval.negateCondition)
+ outputStream << " [negate]";
+ if (eval.controlSuccessor)
+ outputStream << " -> " << eval.controlSuccessor->printIndex;
+ } else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor) {
+ outputStream << " -> " << eval.lexicalSuccessor->printIndex;
+ }
+ if (!eval.position.empty())
+ outputStream << ": " << eval.position.ToString();
+ outputStream << '\n';
}
- void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
- lower::pft::FunctionLikeUnit &functionLikeUnit) {
+ void dumpEvaluation(llvm::raw_ostream &ostream,
+ const lower::pft::Evaluation &eval) {
+ dumpEvaluation(ostream, eval, "");
+ }
+
+ void dumpEvaluationList(llvm::raw_ostream &outputStream,
+ const lower::pft::EvaluationList &evaluationList,
+ int indent = 1) {
+ static const auto white = " ++"s;
+ auto indentString = white.substr(0, indent * 2);
+ for (const auto &eval : evaluationList)
+ dumpEvaluation(outputStream, eval, indentString, indent);
+ }
+
+ void
+ dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
+ const lower::pft::FunctionLikeUnit &functionLikeUnit) {
outputStream << getNodeIndex(functionLikeUnit) << " ";
- llvm::StringRef unitKind{};
- std::string name{};
- std::string header{};
+ llvm::StringRef unitKind;
+ llvm::StringRef name;
+ llvm::StringRef header;
if (functionLikeUnit.beginStmt) {
functionLikeUnit.beginStmt->visit(common::visitors{
- [&](const parser::Statement<parser::ProgramStmt> &statement) {
+ [&](const parser::Statement<parser::ProgramStmt> &stmt) {
unitKind = "Program";
- name = statement.statement.v.ToString();
+ name = toStringRef(stmt.statement.v.source);
},
- [&](const parser::Statement<parser::FunctionStmt> &statement) {
+ [&](const parser::Statement<parser::FunctionStmt> &stmt) {
unitKind = "Function";
- name = std::get<parser::Name>(statement.statement.t).ToString();
- header = statement.source.ToString();
+ name = toStringRef(std::get<parser::Name>(stmt.statement.t).source);
+ header = toStringRef(stmt.source);
},
- [&](const parser::Statement<parser::SubroutineStmt> &statement) {
+ [&](const parser::Statement<parser::SubroutineStmt> &stmt) {
unitKind = "Subroutine";
- name = std::get<parser::Name>(statement.statement.t).ToString();
- header = statement.source.ToString();
+ name = toStringRef(std::get<parser::Name>(stmt.statement.t).source);
+ header = toStringRef(stmt.source);
},
- [&](const parser::Statement<parser::MpSubprogramStmt> &statement) {
+ [&](const parser::Statement<parser::MpSubprogramStmt> &stmt) {
unitKind = "MpSubprogram";
- name = statement.statement.v.ToString();
- header = statement.source.ToString();
+ name = toStringRef(stmt.statement.v.source);
+ header = toStringRef(stmt.source);
},
- [&](const auto &) {},
+ [&](const auto &) { llvm_unreachable("not a valid begin stmt"); },
});
} else {
unitKind = "Program";
name = "<anonymous>";
}
outputStream << unitKind << ' ' << name;
- if (header.size())
+ if (!header.empty())
outputStream << ": " << header;
outputStream << '\n';
dumpEvaluationList(outputStream, functionLikeUnit.evaluationList);
@@ -871,28 +1070,38 @@
outputStream << "\nContains\n";
for (auto &func : functionLikeUnit.nestedFunctions)
dumpFunctionLikeUnit(outputStream, func);
- outputStream << "EndContains\n";
+ outputStream << "End Contains\n";
}
- outputStream << "End" << unitKind << ' ' << name << "\n\n";
+ outputStream << "End " << unitKind << ' ' << name << "\n\n";
}
void dumpModuleLikeUnit(llvm::raw_ostream &outputStream,
- lower::pft::ModuleLikeUnit &moduleLikeUnit) {
+ const lower::pft::ModuleLikeUnit &moduleLikeUnit) {
outputStream << getNodeIndex(moduleLikeUnit) << " ";
outputStream << "ModuleLike: ";
outputStream << "\nContains\n";
for (auto &func : moduleLikeUnit.nestedFunctions)
dumpFunctionLikeUnit(outputStream, func);
- outputStream << "EndContains\nEndModuleLike\n\n";
+ outputStream << "End Contains\nEnd ModuleLike\n\n";
+ }
+
+ // Top level directives
+ void dumpCompilerDirectiveUnit(
+ llvm::raw_ostream &outputStream,
+ const lower::pft::CompilerDirectiveUnit &directive) {
+ outputStream << getNodeIndex(directive) << " ";
+ outputStream << "CompilerDirective: !";
+ outputStream << directive.get<Fortran::parser::CompilerDirective>()
+ .source.ToString();
+ outputStream << "\nEnd CompilerDirective\n\n";
}
template <typename T>
std::size_t getNodeIndex(const T &node) {
- auto addr{static_cast<const void *>(&node)};
- auto it{nodeIndexes.find(addr)};
- if (it != nodeIndexes.end()) {
+ auto addr = static_cast<const void *>(&node);
+ auto it = nodeIndexes.find(addr);
+ if (it != nodeIndexes.end())
return it->second;
- }
nodeIndexes.try_emplace(addr, nextIndex);
return nextIndex++;
}
@@ -919,12 +1128,9 @@
return result;
}
-static const semantics::Symbol *getSymbol(
- std::optional<lower::pft::FunctionLikeUnit::FunctionStatement> &beginStmt) {
- if (!beginStmt)
- return nullptr;
-
- const auto *symbol = beginStmt->visit(common::visitors{
+template <typename A>
+static const semantics::Symbol *getSymbol(A &beginStmt) {
+ const auto *symbol = beginStmt.visit(common::visitors{
[](const parser::Statement<parser::ProgramStmt> &stmt)
-> const semantics::Symbol * { return stmt.statement.v.symbol; },
[](const parser::Statement<parser::FunctionStmt> &stmt)
@@ -937,8 +1143,14 @@
},
[](const parser::Statement<parser::MpSubprogramStmt> &stmt)
-> const semantics::Symbol * { return stmt.statement.v.symbol; },
+ [](const parser::Statement<parser::ModuleStmt> &stmt)
+ -> const semantics::Symbol * { return stmt.statement.v.symbol; },
+ [](const parser::Statement<parser::SubmoduleStmt> &stmt)
+ -> const semantics::Symbol * {
+ return std::get<parser::Name>(stmt.statement.t).symbol;
+ },
[](const auto &) -> const semantics::Symbol * {
- llvm_unreachable("unknown FunctionLike beginStmt");
+ llvm_unreachable("unknown FunctionLike or ModuleLike beginStmt");
return nullptr;
}});
assert(symbol && "parser::Name must have resolved symbol");
@@ -955,13 +1167,25 @@
lower::pft::FunctionLikeUnit *
Fortran::lower::pft::Evaluation::getOwningProcedure() const {
- return parentVariant.visit(common::visitors{
+ return parent.visit(common::visitors{
[](lower::pft::FunctionLikeUnit &c) { return &c; },
[&](lower::pft::Evaluation &c) { return c.getOwningProcedure(); },
[](auto &) -> lower::pft::FunctionLikeUnit * { return nullptr; },
});
}
+bool Fortran::lower::definedInCommonBlock(const semantics::Symbol &sym) {
+ return semantics::FindCommonBlockContaining(sym);
+}
+
+/// Is the symbol `sym` a global?
+static bool symbolIsGlobal(const semantics::Symbol &sym) {
+ if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>())
+ if (details->init())
+ return true;
+ return semantics::IsSaved(sym) || lower::definedInCommonBlock(sym);
+}
+
namespace {
/// This helper class is for sorting the symbols in the symbol table. We want
/// the symbols in an order such that a symbol will be visited after those it
@@ -969,26 +1193,112 @@
/// symbol table, which is sorted by name.
struct SymbolDependenceDepth {
explicit SymbolDependenceDepth(
- std::vector<std::vector<lower::pft::Variable>> &vars)
- : vars{vars} {}
+ std::vector<std::vector<lower::pft::Variable>> &vars, bool reentrant)
+ : vars{vars}, reentrant{reentrant} {}
+
+ void analyzeAliasesInCurrentScope(const semantics::Scope &scope) {
+ for (const auto &iter : scope) {
+ const auto &ultimate = iter.second.get().GetUltimate();
+ if (skipSymbol(ultimate))
+ continue;
+ bool isDeclaration = scope != ultimate.owner();
+ analyzeAliases(ultimate.owner(), isDeclaration);
+ }
+ // add all aggregate stores to the front of the work 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));
+ }
+ }
+ // Analyze the equivalence sets. This analysis need not be performed when the
+ // scope has no equivalence sets.
+ void analyzeAliases(const semantics::Scope &scope, bool isDeclaration) {
+ if (scope.equivalenceSets().empty())
+ return;
+ if (scopeAnlyzedForAliases.find(&scope) != scopeAnlyzedForAliases.end())
+ return;
+ scopeAnlyzedForAliases.insert(&scope);
+ Fortran::lower::IntervalSet intervals;
+ llvm::DenseMap<std::size_t, llvm::SmallVector<const semantics::Symbol *, 8>>
+ aliasSets;
+ llvm::DenseMap<std::size_t, const semantics::Symbol *> setIsGlobal;
+
+ // 1. Construct the intervals. Determine each entity's interval, merging
+ // overlapping intervals into aggregates.
+ for (const auto &pair : scope) {
+ const auto &sym = pair.second.get();
+ if (skipSymbol(sym))
+ continue;
+ LLVM_DEBUG(llvm::dbgs() << "symbol: " << sym << '\n');
+ intervals.merge(sym.offset(), sym.offset() + sym.size() - 1);
+ }
+
+ // 2. Compute alias sets. Adds each entity to a set for the interval it
+ // appears to be mapped into.
+ for (const auto &pair : scope) {
+ const auto &sym = pair.second.get();
+ if (skipSymbol(sym))
+ continue;
+ auto iter = intervals.find(sym.offset());
+ if (iter != intervals.end()) {
+ LLVM_DEBUG(llvm::dbgs()
+ << "symbol: " << toStringRef(sym.name()) << " on ["
+ << iter->first << ".." << iter->second << "]\n");
+ aliasSets[iter->first].push_back(&sym);
+ if (symbolIsGlobal(sym))
+ setIsGlobal.insert({iter->first, &sym});
+ }
+ }
+
+ // 3. For each alias set with more than 1 member, add an Interval to the
+ // stores. The Interval will be lowered into a single memory allocation,
+ // with the co-located, overlapping variables mapped into that memory range.
+ for (const auto &pair : aliasSets) {
+ if (pair.second.size() > 1) {
+ // Set contains more than 1 aliasing variable.
+ // 1. Mark the symbols as aliasing for lowering.
+ for (auto *sym : pair.second)
+ aliasSyms.insert(sym);
+ auto gvarIter = setIsGlobal.find(pair.first);
+ auto iter = intervals.find(pair.first);
+ auto ibgn = iter->first;
+ auto ilen = iter->second - ibgn + 1;
+ // 2. Add an Interval to the list of stores allocated for this unit.
+ lower::pft::Variable::Interval interval(ibgn, ilen);
+ if (gvarIter != setIsGlobal.end()) {
+ LLVM_DEBUG(llvm::dbgs()
+ << "interval [" << ibgn << ".." << ibgn + ilen
+ << ") added as global " << *gvarIter->second << '\n');
+ stores.emplace_back(std::move(interval), scope, pair.second,
+ isDeclaration);
+ } else {
+ LLVM_DEBUG(llvm::dbgs() << "interval [" << ibgn << ".." << ibgn + ilen
+ << ") added\n");
+ stores.emplace_back(std::move(interval), scope, isDeclaration);
+ }
+ }
+ }
+ }
// Recursively visit each symbol to determine the height of its dependence on
// 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;
if (semantics::IsProcedure(sym)) {
// TODO: add declaration?
return 0;
}
- if (sym.has<semantics::UseDetails>() ||
- sym.has<semantics::HostAssocDetails>() ||
- sym.has<semantics::NamelistDetails>() ||
- sym.has<semantics::MiscDetails>()) {
- // FIXME: do we want to do anything with any of these?
+ auto ultimate = sym.GetUltimate();
+ if (!ultimate.has<semantics::ObjectEntityDetails>() &&
+ !ultimate.has<semantics::ProcEntityDetails>())
return 0;
- }
+
+ if (sym.has<semantics::DerivedTypeDetails>())
+ llvm_unreachable("not yet implemented - derived type analysis");
// Symbol must be something lowering will have to allocate.
bool global = semantics::IsSaved(sym);
@@ -998,9 +1308,12 @@
// check CHARACTER's length
if (symTy->category() == semantics::DeclTypeSpec::Character)
- if (auto e = symTy->characterTypeSpec().length().GetExplicit())
+ if (auto e = symTy->characterTypeSpec().length().GetExplicit()) {
+ // turn variable into a global if this unit is not reentrant
+ global = global || !reentrant;
for (const auto &s : evaluate::CollectSymbols(*e))
depth = std::max(analyze(s) + 1, depth);
+ }
if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
auto doExplicit = [&](const auto &bound) {
@@ -1011,11 +1324,15 @@
}
};
// handle any symbols in array bound declarations
+ if (!details->shape().empty())
+ global = global || !reentrant;
for (const auto &subs : details->shape()) {
doExplicit(subs.lbound());
doExplicit(subs.ubound());
}
// handle any symbols in coarray bound declarations
+ if (!details->coshape().empty())
+ global = global || !reentrant;
for (const auto &subs : details->coshape()) {
doExplicit(subs.lbound());
doExplicit(subs.ubound());
@@ -1030,23 +1347,69 @@
}
adjustSize(depth + 1);
vars[depth].emplace_back(sym, global, depth);
- if (Fortran::semantics::IsAllocatable(sym))
+ if (semantics::IsAllocatable(sym))
vars[depth].back().setHeapAlloc();
- if (Fortran::semantics::IsPointer(sym))
+ if (semantics::IsPointer(sym))
vars[depth].back().setPointer();
- if (sym.attrs().test(Fortran::semantics::Attr::TARGET))
+ if (ultimate.attrs().test(semantics::Attr::TARGET))
vars[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 (auto *store = findStoreIfAlias(sym)) {
+ vars[depth].back().setAlias(store->getOffset());
+ }
return depth;
}
- // Save the final list of symbols as a single vector and free the rest.
+ /// 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);
}
+ Fortran::lower::pft::Variable::AggregateStore *
+ findStoreIfAlias(const Fortran::evaluate::Symbol &sym) {
+ const auto &ultimate = sym.GetUltimate();
+ const auto &scope = ultimate.owner();
+ // Expect the total number of EQUIVALENCE sets to be small for a typical
+ // Fortran program.
+ if (aliasSyms.find(&ultimate) != aliasSyms.end()) {
+ LLVM_DEBUG(llvm::dbgs() << "symbol: " << ultimate << '\n');
+ LLVM_DEBUG(llvm::dbgs() << "scope: " << scope << '\n');
+ auto off = ultimate.offset();
+ for (auto &v : stores) {
+ if (v.scope == &scope) {
+ auto bot = std::get<0>(v.interval);
+ if (off >= bot && off < bot + std::get<1>(v.interval))
+ return &v;
+ }
+ }
+ // clang-format off
+ LLVM_DEBUG(
+ llvm::dbgs() << "looking for " << off << "\n{\n";
+ for (auto v : stores) {
+ llvm::dbgs() << " in scope: " << v.scope << "\n";
+ llvm::dbgs() << " i = [" << std::get<0>(v.interval) << ".."
+ << std::get<0>(v.interval) + std::get<1>(v.interval)
+ << "]\n";
+ }
+ llvm::dbgs() << "}\n");
+ // clang-format on
+ llvm_unreachable("the store must be present");
+ }
+ return nullptr;
+ }
+
private:
+ /// Skip symbol in alias analysis.
+ bool skipSymbol(const semantics::Symbol &sym) {
+ return !sym.has<semantics::ObjectEntityDetails>() ||
+ lower::definedInCommonBlock(sym);
+ }
+
// Make sure the table is of appropriate size.
void adjustSize(std::size_t size) {
if (vars.size() < size)
@@ -1055,93 +1418,102 @@
llvm::SmallSet<const semantics::Symbol *, 32> seen;
std::vector<std::vector<lower::pft::Variable>> &vars;
+ llvm::SmallSet<const semantics::Symbol *, 32> aliasSyms;
+ llvm::SmallSet<const semantics::Scope *, 4> scopeAnlyzedForAliases;
+ std::vector<Fortran::lower::pft::Variable::AggregateStore> stores;
+ bool reentrant;
};
} // namespace
-void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable(
- const semantics::Scope &scope) {
- // TODO: handle equivalence and common blocks
- if (!scope.equivalenceSets().empty()) {
- llvm::errs() << "TODO: equivalence not yet handled in lowering.\n"
- << "note: equivalence used in "
- << (scope.GetName() && !scope.GetName()->empty()
- ? scope.GetName()->ToString()
- : "unnamed program"s)
- << "\n";
- exit(1);
- }
- SymbolDependenceDepth sdd{varList};
+static void processSymbolTable(
+ const semantics::Scope &scope,
+ std::vector<std::vector<Fortran::lower::pft::Variable>> &varList,
+ bool reentrant) {
+ SymbolDependenceDepth sdd{varList, reentrant};
+ sdd.analyzeAliasesInCurrentScope(scope);
for (const auto &iter : scope)
sdd.analyze(iter.second.get());
sdd.finalize();
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
- const parser::MainProgram &func, const lower::pft::ParentVariant &parent,
+ const parser::MainProgram &func, const lower::pft::PftNode &parent,
const semantics::SemanticsContext &semanticsContext)
: ProgramUnit{func, parent}, endStmt{
getFunctionStmt<parser::EndProgramStmt>(
func)} {
- const auto &ps{
- std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t)};
- if (ps.has_value()) {
- FunctionStatement begin{ps.value()};
- beginStmt = begin;
- symbol = getSymbol(beginStmt);
- processSymbolTable(*symbol->scope());
+ const auto &programStmt =
+ std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t);
+ if (programStmt.has_value()) {
+ beginStmt = FunctionStatement(programStmt.value());
+ const auto *symbol = getSymbol(*beginStmt);
+ entryPointList[0].first = symbol;
+ processSymbolTable(*symbol->scope(), varList, isRecursive());
} else {
- processSymbolTable(semanticsContext.FindScope(
- std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source));
+ processSymbolTable(
+ semanticsContext.FindScope(
+ std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source),
+ varList, isRecursive());
}
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
- const parser::FunctionSubprogram &func,
- const lower::pft::ParentVariant &parent,
+ const parser::FunctionSubprogram &func, const lower::pft::PftNode &parent,
const semantics::SemanticsContext &)
: ProgramUnit{func, parent},
beginStmt{getFunctionStmt<parser::FunctionStmt>(func)},
- endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)}, symbol{getSymbol(
- beginStmt)} {
- processSymbolTable(*symbol->scope());
+ endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {
+ const auto *symbol = getSymbol(*beginStmt);
+ entryPointList[0].first = symbol;
+ processSymbolTable(*symbol->scope(), varList, isRecursive());
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
- const parser::SubroutineSubprogram &func,
- const lower::pft::ParentVariant &parent,
+ const parser::SubroutineSubprogram &func, const lower::pft::PftNode &parent,
const semantics::SemanticsContext &)
: ProgramUnit{func, parent},
beginStmt{getFunctionStmt<parser::SubroutineStmt>(func)},
- endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)},
- symbol{getSymbol(beginStmt)} {
- processSymbolTable(*symbol->scope());
+ endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {
+ const auto *symbol = getSymbol(*beginStmt);
+ entryPointList[0].first = symbol;
+ processSymbolTable(*symbol->scope(), varList, isRecursive());
}
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
const parser::SeparateModuleSubprogram &func,
- const lower::pft::ParentVariant &parent,
- const semantics::SemanticsContext &)
+ const lower::pft::PftNode &parent, const semantics::SemanticsContext &)
: ProgramUnit{func, parent},
beginStmt{getFunctionStmt<parser::MpSubprogramStmt>(func)},
- endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)},
- symbol{getSymbol(beginStmt)} {
- processSymbolTable(*symbol->scope());
+ endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {
+ const auto *symbol = getSymbol(*beginStmt);
+ entryPointList[0].first = symbol;
+ processSymbolTable(*symbol->scope(), varList, isRecursive());
}
Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
- const parser::Module &m, const lower::pft::ParentVariant &parent)
+ const parser::Module &m, const lower::pft::PftNode &parent)
: ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
- endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {}
+ endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {
+ const auto *symbol = getSymbol(beginStmt);
+ processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false);
+}
Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
- const parser::Submodule &m, const lower::pft::ParentVariant &parent)
+ const parser::Submodule &m, const lower::pft::PftNode &parent)
: ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
m)},
- endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
+ endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {
+ const auto *symbol = getSymbol(beginStmt);
+ processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false);
+}
Fortran::lower::pft::BlockDataUnit::BlockDataUnit(
- const parser::BlockData &bd, const lower::pft::ParentVariant &parent)
- : ProgramUnit{bd, parent} {}
+ const parser::BlockData &bd, const lower::pft::PftNode &parent,
+ const semantics::SemanticsContext &semanticsContext)
+ : ProgramUnit{bd, parent},
+ symTab{semanticsContext.FindScope(
+ std::get<parser::Statement<parser::EndBlockDataStmt>>(bd.t).source)} {
+}
std::unique_ptr<lower::pft::Program>
Fortran::lower::createPFT(const parser::Program &root,
@@ -1151,9 +1523,67 @@
return walker.result();
}
+// FIXME: FlangDriver
+// This option should be integrated with the real driver as the default of
+// RECURSIVE vs. NON_RECURSIVE may be changed by other command line options,
+// etc., etc.
+bool Fortran::lower::defaultRecursiveFunctionSetting() {
+ return !nonRecursiveProcedures;
+}
+
void Fortran::lower::dumpPFT(llvm::raw_ostream &outputStream,
- lower::pft::Program &pft) {
+ const lower::pft::Program &pft) {
PFTDumper{}.dumpPFT(outputStream, pft);
}
-void Fortran::lower::pft::Program::dump() { dumpPFT(llvm::errs(), *this); }
+void Fortran::lower::pft::Program::dump() const {
+ dumpPFT(llvm::errs(), *this);
+}
+
+void Fortran::lower::pft::Evaluation::dump() const {
+ PFTDumper{}.dumpEvaluation(llvm::errs(), *this);
+}
+
+void Fortran::lower::pft::Variable::dump() const {
+ if (auto *s = std::get_if<Nominal>(&var)) {
+ llvm::errs() << "symbol: " << s->symbol->name();
+ llvm::errs() << " (depth: " << s->depth << ')';
+ if (s->global)
+ llvm::errs() << ", global";
+ if (s->heapAlloc)
+ llvm::errs() << ", allocatable";
+ if (s->pointer)
+ llvm::errs() << ", pointer";
+ if (s->target)
+ llvm::errs() << ", target";
+ if (s->aliaser)
+ llvm::errs() << ", equivalence(" << s->aliasOffset << ')';
+ } else if (auto *s = std::get_if<AggregateStore>(&var)) {
+ llvm::errs() << "interval[" << std::get<0>(s->interval) << ", "
+ << std::get<1>(s->interval) << "]:";
+ if (s->isGlobal())
+ llvm::errs() << ", global";
+ if (s->vars.size()) {
+ llvm::errs() << ", vars: {";
+ llvm::interleaveComma(s->vars, llvm::errs(),
+ [](auto *y) { llvm::errs() << *y; });
+ llvm::errs() << '}';
+ }
+ } else {
+ llvm_unreachable("not a Variable");
+ }
+ llvm::errs() << '\n';
+}
+
+void Fortran::lower::pft::FunctionLikeUnit::dump() const {
+ PFTDumper{}.dumpFunctionLikeUnit(llvm::errs(), *this);
+}
+
+void Fortran::lower::pft::ModuleLikeUnit::dump() const {
+ PFTDumper{}.dumpModuleLikeUnit(llvm::errs(), *this);
+}
+
+/// The BlockDataUnit dump is just the associated symbol table.
+void Fortran::lower::pft::BlockDataUnit::dump() const {
+ llvm::errs() << "block data {\n" << symTab << "\n}\n";
+}
diff --git a/test/Lower/pre-fir-tree01.f90 b/test/Lower/pre-fir-tree01.f90
index 23f9fd1..707dbc1 100644
--- a/test/Lower/pre-fir-tree01.f90
+++ b/test/Lower/pre-fir-tree01.f90
@@ -20,8 +20,9 @@
! CHECK: EndDoStmt
end do
! CHECK: <<End DoConstruct>>
+! CHECK: EndSubroutineStmt
end subroutine
-! CHECK: EndSubroutine foo
+! CHECK: End Subroutine foo
! CHECK: BlockData
block data
@@ -29,7 +30,7 @@
integer, dimension(n) :: a, b, c
common /arrays/ a, b, c
end
-! CHECK: EndBlockData
+! CHECK: End BlockData
! CHECK: ModuleLike
module test_mod
@@ -44,49 +45,57 @@
contains
! CHECK: Subroutine foo
subroutine foo()
+ ! CHECK: EndSubroutineStmt
contains
! CHECK: Subroutine subfoo
subroutine subfoo()
- end subroutine
- ! CHECK: EndSubroutine subfoo
+ ! CHECK: EndSubroutineStmt
+ 9 end subroutine
+ ! CHECK: End Subroutine subfoo
! CHECK: Function subfoo2
function subfoo2()
- end function
- ! CHECK: EndFunction subfoo2
+ ! CHECK: EndFunctionStmt
+ 9 end function
+ ! CHECK: End Function subfoo2
end subroutine
- ! CHECK: EndSubroutine foo
+ ! CHECK: End Subroutine foo
! CHECK: Function foo2
function foo2(i, j)
integer i, j, foo2
! CHECK: AssignmentStmt
foo2 = i + j
+ ! CHECK: EndFunctionStmt
contains
! CHECK: Subroutine subfoo
subroutine subfoo()
+ ! CHECK: EndSubroutineStmt
end subroutine
- ! CHECK: EndSubroutine subfoo
+ ! CHECK: End Subroutine subfoo
end function
- ! CHECK: EndFunction foo2
+ ! CHECK: End Function foo2
end module
-! CHECK: EndModuleLike
+! CHECK: End ModuleLike
! CHECK: ModuleLike
submodule (test_mod) test_mod_impl
contains
! CHECK: Subroutine foo
subroutine foo()
+ ! CHECK: EndSubroutineStmt
contains
! CHECK: Subroutine subfoo
subroutine subfoo()
+ ! CHECK: EndSubroutineStmt
end subroutine
- ! CHECK: EndSubroutine subfoo
+ ! CHECK: End Subroutine subfoo
! CHECK: Function subfoo2
function subfoo2()
+ ! CHECK: EndFunctionStmt
end function
- ! CHECK: EndFunction subfoo2
+ ! CHECK: End Function subfoo2
end subroutine
- ! CHECK: EndSubroutine foo
+ ! CHECK: End Subroutine foo
! CHECK: MpSubprogram dump
module procedure dump
! CHECK: FormatStmt
@@ -105,19 +114,34 @@
! CHECK: <<End IfConstruct>>
end procedure
end submodule
-! CHECK: EndModuleLike
+! CHECK: End ModuleLike
! CHECK: BlockData
block data named_block
integer i, j, k
common /indexes/ i, j, k
end
-! CHECK: EndBlockData
+! CHECK: End BlockData
! CHECK: Function bar
function bar()
+! CHECK: EndFunctionStmt
end function
-! CHECK: EndFunction bar
+! CHECK: End Function bar
+
+! Test top level directives
+!DIR$ INTEGER=64
+! CHECK: CompilerDirective:
+! CHECK: End CompilerDirective
+
+! Test nested directive
+! CHECK: Subroutine test_directive
+subroutine test_directive()
+ !DIR$ INTEGER=64
+ ! CHECK: <<CompilerDirective>>
+ ! CHECK: <<End CompilerDirective>>
+end subroutine
+! CHECK: EndSubroutine
! CHECK: Program <anonymous>
! check specification parts are not part of the PFT.
@@ -127,4 +151,4 @@
! CHECK: AllocateStmt
allocate(x(foo2(10, 30)))
end
-! CHECK: EndProgram
+! CHECK: End Program
diff --git a/test/Lower/pre-fir-tree02.f90 b/test/Lower/pre-fir-tree02.f90
index 9e16c4e..6f64b60 100644
--- a/test/Lower/pre-fir-tree02.f90
+++ b/test/Lower/pre-fir-tree02.f90
@@ -146,12 +146,15 @@
! CHECK: ModuleLike
module test
- type :: a_type
- integer :: x
- end type
- type, extends(a_type) :: b_type
- integer :: y
- end type
+ !! When derived type processing is implemented, remove all instances of:
+ !! - !![disable]
+ !! - COM:
+ !![disable]type :: a_type
+ !![disable] integer :: x
+ !![disable]end type
+ !![disable]type, extends(a_type) :: b_type
+ !![disable] integer :: y
+ !![disable]end type
contains
! CHECK: Function foo
function foo(x)
@@ -191,12 +194,12 @@
type is (integer)
! CHECK: AssignmentStmt
bar = 0
- ! CHECK: TypeGuardStmt
- class is (a_type)
- ! CHECK: AssignmentStmt
- bar = 1
- ! CHECK: ReturnStmt
- return
+ !![disable]! COM: CHECK: TypeGuardStmt
+ !![disable]class is (a_type)
+ !![disable] ! COM: CHECK: AssignmentStmt
+ !![disable] bar = 1
+ !![disable] ! COM: CHECK: ReturnStmt
+ !![disable] return
! CHECK: TypeGuardStmt
class default
! CHECK: AssignmentStmt
@@ -329,6 +332,5 @@
subroutine sub4()
integer :: i
print*, "test"
- ! CHECK: DataStmt
data i /1/
end subroutine
diff --git a/test/Lower/pre-fir-tree04.f90 b/test/Lower/pre-fir-tree04.f90
index 3f2beaf..55b0cb1 100644
--- a/test/Lower/pre-fir-tree04.f90
+++ b/test/Lower/pre-fir-tree04.f90
@@ -1,4 +1,4 @@
-! RUN: %f18 -fdebug-pre-fir-tree -fsyntax-only %s | FileCheck %s
+! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree %s | FileCheck %s
! Test Pre-FIR Tree captures all the coarray related statements
diff --git a/test/Lower/pre-fir-tree05.f90 b/test/Lower/pre-fir-tree05.f90
index fb57663..9096e38 100644
--- a/test/Lower/pre-fir-tree05.f90
+++ b/test/Lower/pre-fir-tree05.f90
@@ -27,9 +27,9 @@
!$acc end parallel
! CHECK-NEXT: <<End OpenACCConstruct>>
! CHECK-NEXT: <<End OpenACCConstruct>>
- ! CHECK-NEXT: ContinueStmt
+ ! CHECK-NEXT: EndSubroutineStmt
end subroutine
-! CHECK-NEXT: EndSubroutine foo
+! CHECK-NEXT: End Subroutine foo
! CHECK: Subroutine foo
subroutine foo2()
@@ -43,7 +43,7 @@
end do
!$acc end parallel loop
! CHECK-NEXT: <<End OpenACCConstruct>>
- ! CHECK-NEXT: ContinueStmt
+ ! CHECK-NEXT: EndSubroutineStmt
end subroutine
-! CHECK-NEXT: EndSubroutine foo2
+! CHECK-NEXT: End Subroutine foo2
