[flang][fir] Upstream changes to the pre-FIR tree

[schweitz]

Summary

Upgrade the PFT to support the lowering of Fortran 77.

Update the tests.

[jeanPerier]

You may want to apply the clang-tidy hints about const auto ([llvm-qualified-auto]), otherwise LGTM and builds ok for me.

[awarzynski]

Hi @schweitz , thank you for working on this!

Sadly pre-fir-tree04.f90 won't work with the new driver just yet - we need https://reviews.llvm.org/D97080 first. I've restored the original run line here: https://github.com/llvm/llvm-project/commit/547624af1963f082f0c4676b0c019528372f6f13.

I will make sure to update pre-fir-tree04.f90 again once D97080 is merged. I hope that this is OK!

[schweitz]

Thank you for the quick fix, @awarzynski.

flang/include/flang/Lower/IO.h

 
 class AbstractConverter;
 class BridgeImpl;
 
 namespace pft {
 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
 
 /// Generate IO call(s) for BACKSPACE; return the IOSTAT code
 mlir::Value genBackspaceStatement(AbstractConverter &,
                                   const parser::BackspaceStmt &);
 
 /// Generate IO call(s) for CLOSE; return the IOSTAT code

flang/include/flang/Lower/PFTBuilder.h

 //===-- Lower/PFTBuilder.h -- PFT builder -----------------------*- 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/
+//
+//===----------------------------------------------------------------------===//
+//
 // PFT (Pre-FIR Tree) interface.
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_PFTBUILDER_H
 #define FORTRAN_LOWER_PFTBUILDER_H
 
 #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 *>;
 
 /// Provide a variant like container that can hold references. It can hold
 /// constant or mutable references. It is used in the other classes to provide
 /// union of const references to parse-tree nodes.
 template <bool isConst, typename... A>
 class ReferenceVariantBase {
 public:
   template <typename B>
   using BaseType = std::conditional_t<isConst, const B, B>;
   template <typename B>
   using Ref = common::Reference<BaseType<B>>;
 
   ReferenceVariantBase() = delete;
   ReferenceVariantBase(std::variant<Ref<A>...> b) : u(b) {}
   template <typename T>
   ReferenceVariantBase(Ref<T> b) : u(b) {}
 
   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 {
     auto *ptr = std::get_if<Ref<B>>(&u);
     return ptr ? &ptr->get() : nullptr;
   }
   template <typename B>
   constexpr bool isA() const {

 private:
   std::variant<Ref<A>...> u;
 };
 template <typename... A>
 using ReferenceVariant = ReferenceVariantBase<true, A...>;
 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,
 
 /// Classify the parse-tree nodes from ExecutablePartConstruct
 
 using ActionStmts = std::tuple<
     parser::AllocateStmt, parser::AssignmentStmt, parser::BackspaceStmt,
     parser::CallStmt, parser::CloseStmt, parser::ContinueStmt,
     parser::CycleStmt, parser::DeallocateStmt, parser::EndfileStmt,
     parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
     parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
     parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
     parser::NullifyStmt, parser::OpenStmt, parser::PointerAssignmentStmt,
     parser::PrintStmt, parser::ReadStmt, parser::ReturnStmt, parser::RewindStmt,
     parser::StopStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
     parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt,
     parser::WaitStmt, parser::WhereStmt, parser::WriteStmt,
     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,
     parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt,
     parser::EndSelectStmt, parser::ChangeTeamStmt, parser::EndChangeTeamStmt,
     parser::CriticalStmt, parser::EndCriticalStmt, parser::NonLabelDoStmt,
     parser::EndDoStmt, parser::IfThenStmt, parser::ElseIfStmt, parser::ElseStmt,
     parser::EndIfStmt, parser::SelectRankStmt, parser::SelectRankCaseStmt,
     parser::SelectTypeStmt, parser::TypeGuardStmt, parser::WhereConstructStmt,
     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,
                parser::CriticalConstruct, parser::DoConstruct,
                parser::IfConstruct, parser::SelectRankConstruct,
                parser::SelectTypeConstruct, parser::WhereConstruct,
                parser::ForallConstruct>;
 
 using Directives =
     std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
                parser::OpenMPConstruct, parser::OmpEndLoopDirective>;
 
 template <typename A>
 static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
 
 template <typename A>
 static constexpr bool isOtherStmt{common::HasMember<A, OtherStmts>};
 
 template <typename A>
 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>
 static constexpr bool isDirective{common::HasMember<A, Directives>};
 
 template <typename A>
 static constexpr bool isIntermediateConstructStmt{common::HasMember<
     A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
                   parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
 
 template <typename A>
 static constexpr bool isNopConstructStmt{common::HasMember<
     A, std::tuple<parser::EndAssociateStmt, parser::CaseStmt,
                   parser::EndSelectStmt, parser::ElseIfStmt, parser::ElseStmt,
                   parser::EndIfStmt, parser::SelectRankCaseStmt,
                   parser::TypeGuardStmt>>};
 
 template <typename A>
 static constexpr bool isFunctionLike{common::HasMember<
     A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
                   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>
 struct MakeReferenceVariantHelper<std::variant<A...>> {
   using type = ReferenceVariant<A...>;
 };
 template <typename... A>
 struct MakeReferenceVariantHelper<std::tuple<A...>> {
   using type = ReferenceVariant<A...>;
 };
 template <typename A>
 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, ...>).
 using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;
 
 /// Function-like units contain lists of evaluations.  These can be simple
 /// statements or constructs, where a construct contains its own evaluations.
 struct Evaluation : EvaluationVariant {
 
   /// 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");
   }
 
   /// Evaluation classification predicates.
   constexpr bool isActionStmt() const {
     return visit(common::visitors{
         [](auto &r) { return pft::isActionStmt<std::decay_t<decltype(r)>>; }});
   }
   constexpr bool isOtherStmt() const {
     return visit(common::visitors{
         [](auto &r) { return pft::isOtherStmt<std::decay_t<decltype(r)>>; }});
   }
   constexpr bool isConstructStmt() const {
     return visit(common::visitors{[](auto &r) {
       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)>>; }});
   }
   constexpr bool isDirective() const {
     return visit(common::visitors{
         [](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
   }
   constexpr bool isNopConstructStmt() const {
     return visit(common::visitors{[](auto &r) {
       return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
     }});
   }
 
   /// Return the predicate:  "This is a non-initial, non-terminal construct
   /// statement."  For an IfConstruct, this is ElseIfStmt and ElseStmt.
   constexpr bool isIntermediateConstructStmt() const {
     return visit(common::visitors{[](auto &r) {
       return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
     }});
   }
 
+  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 {
     Evaluation *successor = lexicalSuccessor;
     if (successor && successor->isNopConstructStmt()) {
       successor = successor->parentConstruct->constructExit;
     }
     assert(successor && "missing successor");
struct Evaluation : EvaluationVariant {
   }
 
   /// Return the FunctionLikeUnit containing this evaluation (or nullptr).
   FunctionLikeUnit *getOwningProcedure() const;
 
   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
   // statement and propagated to enclosing constructs.  This distinction allows
   // a structured IF or DO statement to be materialized with custom structured
   // 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
   Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
   Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt
   Evaluation *controlSuccessor{nullptr}; // set for some statements
   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
 };
 
 using ProgramVariant =
     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; }
-
-  void setHeapAlloc(bool to = true) { heapAlloc = to; }
-  void setPointer(bool to = true) { pointer = to; }
-  void setTarget(bool to = true) { target = to; }
+  /// Return the aggregate store.
+  const AggregateStore &getAggregateStore() const {
+    assert(isAggregateStore());
+    return std::get<AggregateStore>(var);
+  }
+
+  /// 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
 /// nested function-like units (internal procedures and function statements).
 struct FunctionLikeUnit : public ProgramUnit {
   // wrapper statements for function-like syntactic structures
   using FunctionStatement =
       ReferenceVariant<parser::Statement<parser::ProgramStmt>,
                        parser::Statement<parser::EndProgramStmt>,
                        parser::Statement<parser::FunctionStmt>,
                        parser::Statement<parser::EndFunctionStmt>,
                        parser::Statement<parser::SubroutineStmt>,
                        parser::Statement<parser::EndSubroutineStmt>,
                        parser::Statement<parser::MpSubprogramStmt>,
                        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]; }
 
   bool isMainProgram() const {
     return endStmt.isA<parser::Statement<parser::EndProgramStmt>>();
   }
 
   /// Get the starting source location for this function like unit
   parser::CharBlock getStartingSourceLoc() {
     if (beginStmt)
       return stmtSourceLoc(*beginStmt);
     if (!evaluationList.empty())
       return evaluationList.front().position;
     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;
   EvaluationList evaluationList;
   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;
 };
 
 /// Module-like units contain a list of function-like units.
 struct ModuleLikeUnit : public ProgramUnit {
   // wrapper statements for module-like syntactic structures
   using ModuleStatement =
       ReferenceVariant<parser::Statement<parser::ModuleStmt>,
                        parser::Statement<parser::EndModuleStmt>,
                        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.
 /// The PFT captures pointers back into the parse tree, so the parse tree must
 /// not be changed between the construction of the PFT and its last use.  The
 /// PFT captures a structured view of a program.  A program is a list of units.
 /// A function like unit contains a list of evaluations.  An evaluation is
 /// either a statement, or a construct with a nested list of evaluations.
 std::unique_ptr<pft::Program>
 createPFT(const parser::Program &root,
           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

flang/include/flang/Lower/PFTDefs.h

+//===-- 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

flang/include/flang/Lower/Support/Utils.h

+//===-- 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

flang/lib/Lower/IntervalSet.h

+//===-- 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

flang/lib/Lower/PFTBuilder.cpp

 //===-- PFTBuilder.cc -----------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/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 {
 /// Helpers to unveil parser node inside Fortran::parser::Statement<>,
 /// Fortran::parser::UnlabeledStatement, and Fortran::common::Indirection<>
 template <typename A>
 struct RemoveIndirectionHelper {
   using Type = A;

 /// The instantiation of a parse tree visitor (Pre and Post) is extremely
 /// expensive in terms of compile and link time.  So one goal here is to
 /// limit the bridge to one such instantiation.
 class PFTBuilder {
 public:
   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
   std::unique_ptr<lower::pft::Program> result() { return std::move(pgm); }
 
   template <typename A>
   constexpr bool Pre(const A &a) {
     if constexpr (lower::pft::isFunctionLike<A>) {
       return enterFunction(a, semanticsContext);
     } else if constexpr (lower::pft::isConstruct<A> ||
                          lower::pft::isDirective<A>) {
       return enterConstructOrDirective(a);
     } 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 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>) {
       exitFunction();
     } else if constexpr (lower::pft::isConstruct<A> ||
                          lower::pft::isDirective<A>) {
       exitConstructOrDirective();
     }
   }
 
   // Module like
   bool Pre(const parser::Module &node) { return enterModule(node); }
   bool Pre(const parser::Submodule &node) { return enterModule(node); }
 
   void Post(const parser::Module &) { exitModule(); }
   void Post(const parser::Submodule &) { exitModule(); }
 
   // 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));
     return false;
   }
   bool Pre(const parser::WhereBodyConstruct &whereBody) {
     return std::visit(
         common::visitors{
             [&](const parser::Statement<parser::AssignmentStmt> &stmt) {
               // 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;
             },
             [&](const auto &) { return true; },
         },
         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.
   template <typename A>
   bool enterFunction(const A &func,
                      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;
             assignSymbolLabelMap = &p.assignSymbolLabelMap;
           },
           [&](lower::pft::ModuleLikeUnit &p) {
             functionList = &p.nestedFunctions;
           },
private:
   // The other cases use an Indirection, which are discarded in the PFT.
   lower::pft::Evaluation
   makeEvaluationAction(const parser::ActionStmt &statement,
                        parser::CharBlock position,
                        std::optional<parser::Label> label) {
     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);
   }
 
   /// 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;
       } else {
         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
   void popEvaluationList() {
     assert(functionList && "not in a function");
     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);
       }
     }};
 
     using OtherIOStmts =
         std::tuple<parser::BackspaceStmt, parser::CloseStmt,
                    parser::EndfileStmt, parser::FlushStmt, parser::OpenStmt,
                    parser::RewindStmt, parser::WaitStmt>;
 
     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>,
                     "Unexpected IO statement");
     }
   }
 
   /// Set the exit of a construct, possibly from multiple enclosing constructs.
   void setConstructExit(lower::pft::Evaluation &eval) {
     eval.constructExit = &eval.evaluationList->back().nonNopSuccessor();
   }
 
   /// Mark the target of a branch as a new block.
   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;
     if (targetConstruct) {
       while (sourceConstruct && sourceConstruct != targetConstruct)
         sourceConstruct = sourceConstruct->parentConstruct;
       if (sourceConstruct != targetConstruct)
         for (auto *eval = &targetEvaluation; eval; eval = eval->parentConstruct)
using MaybeConstructNameInTuple = std::tuple<
         parser::AssociateStmt, parser::CaseStmt, parser::ChangeTeamStmt,
         parser::CriticalStmt, parser::ElseIfStmt, parser::EndChangeTeamStmt,
         parser::ForallConstructStmt, parser::IfThenStmt, parser::LabelDoStmt,
         parser::MaskedElsewhereStmt, parser::NonLabelDoStmt,
         parser::SelectCaseStmt, parser::SelectRankCaseStmt,
         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 {};
   }
 
   /// \p parentConstruct can be null if this statement is at the highest
   /// level of a program.
   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.
   /// \p parentConstruct can be null if the evaluationList contains the
   /// 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]};
             assert(construct && "missing CYCLE construct");
             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]};
             assert(construct && "missing EXIT construct");
             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)
               markSuccessorAsNewBlock(eval);
           },
           [&](const parser::StopStmt &) {
             eval.isUnstructured = true;
             if (eval.lexicalSuccessor->lexicalSuccessor)
               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);
             const auto *sym = std::get<parser::Name>(s.t).symbol;
             assert(sym && "missing AssignStmt symbol");
             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{};
               labelSet.insert(label);
               assignSymbolLabelMap->try_emplace(*sym, labelSet);
             } else {
               iter->second.insert(label);
             }
for (auto &eval : evaluationList) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::CriticalStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](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) {
             insertConstructName(s, parentConstruct);
             eval.lexicalSuccessor->isNewBlock = true;
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::ElseIfStmt &) {
             eval.isNewBlock = true;
             eval.lexicalSuccessor->isNewBlock = true;
             lastConstructStmtEvaluation->controlSuccessor = &eval;
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::ElseStmt &) {
             eval.isNewBlock = true;
             lastConstructStmtEvaluation->controlSuccessor = &eval;
             lastConstructStmtEvaluation = nullptr;
           },
           [&](const parser::EndIfStmt &) {
-            if (parentConstruct->lowerAsUnstructured()) {
+            if (parentConstruct->lowerAsUnstructured())
               parentConstruct->constructExit->isNewBlock = true;
-            }
             if (lastConstructStmtEvaluation) {
               lastConstructStmtEvaluation->controlSuccessor =
                   parentConstruct->constructExit;
               lastConstructStmtEvaluation = nullptr;
             }
           },
           [&](const parser::SelectRankStmt &s) {
             insertConstructName(s, parentConstruct);
for (auto &eval : evaluationList) {
             setConstructExit(eval);
             eval.isUnstructured = true;
           },
           [&](const parser::SelectTypeConstruct &) {
             setConstructExit(eval);
             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,
+            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 &&
           eval.lexicalSuccessor->isIntermediateConstructStmt()) {
         eval.controlSuccessor = parentConstruct->constructExit;
         eval.lexicalSuccessor->isNewBlock = true;
       }
 
       // 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) {
     });
   }
 
-  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();
-      }
-      outputStream << '\n';
-    }
+  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.constructExit)
+      return;
+    if (eval.printIndex)
+    if (eval.isNewBlock)
+      if (eval.negateCondition)
+        outputStream << " [negate]";
+      if (eval.controlSuccessor)
+    } else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor) {
+      outputStream << " -> " << eval.lexicalSuccessor->printIndex;
+    if (!eval.position.empty())
+
+  void dumpEvaluation(llvm::raw_ostream &ostream,
+                      const lower::pft::Evaluation &eval) {
+    dumpEvaluation(ostream, eval, "");
   }
 
-  void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
-                            lower::pft::FunctionLikeUnit &functionLikeUnit) {
+  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);
     if (!functionLikeUnit.nestedFunctions.empty()) {
       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++;
   }
   std::size_t getNodeIndex(const lower::pft::Program &) { return 0; }
 
 private:
   llvm::DenseMap<const void *, std::size_t> nodeIndexes;
   std::size_t nextIndex{1}; // 0 is the root

 }
 template <typename A, typename T>
 static lower::pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
   lower::pft::ModuleLikeUnit::ModuleStatement result{
       std::get<parser::Statement<A>>(mod.t)};
   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)
           -> const semantics::Symbol * {
         return std::get<parser::Name>(stmt.statement.t).symbol;
       },
       [](const parser::Statement<parser::SubroutineStmt> &stmt)
           -> const semantics::Symbol * {
         return std::get<parser::Name>(stmt.statement.t).symbol;
       },
       [](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");
   return symbol;
 }
 
 bool Fortran::lower::pft::Evaluation::lowerAsStructured() const {
   return !lowerAsUnstructured();
 }
 
 bool Fortran::lower::pft::Evaluation::lowerAsUnstructured() const {
   return isUnstructured || clDisableStructuredFir;
 }
 
 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
 /// depends upon. Otherwise this sort is stable and preserves the order of the
 /// symbol table, which is sorted by name.
 struct SymbolDependenceDepth {
   explicit SymbolDependenceDepth(
-      std::vector<std::vector<lower::pft::Variable>> &vars)
-      : vars{vars} {}
+      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);
     int depth = 0;
     const auto *symTy = sym.GetType();
     assert(symTy && "symbol must have a type");
 
     // 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) {
         if (bound.isExplicit()) {
           semantics::SomeExpr e{*bound.GetExplicit()};
           for (const auto &s : evaluate::CollectSymbols(e))
             depth = std::max(analyze(s) + 1, depth);
         }
       };
       // 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());
       }
       // handle any symbols in initialization expressions
       if (auto e = details->init()) {
         // A PARAMETER may not be marked as implicitly SAVE, so set the flag.
         global = true;
         for (const auto &s : evaluate::CollectSymbols(*e))
           depth = std::max(analyze(s) + 1, depth);
       }
     }
     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)
       vars.resize(size);
   }
 
   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,
                           const semantics::SemanticsContext &semanticsContext) {
   PFTBuilder walker(semanticsContext);
   Walk(root, walker);
   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";
+}

flang/test/Lower/pre-fir-tree01.f90

do j=1,5
       ! CHECK: PrintStmt
       print *, "hello", i, j
     ! CHECK: EndDoStmt
     end do
     ! CHECK: <<End DoConstruct>>
   ! CHECK: EndDoStmt
   end do
   ! CHECK: <<End DoConstruct>>
+! CHECK: EndSubroutineStmt
 end subroutine
-! CHECK: EndSubroutine foo
+! CHECK: End Subroutine foo
 
 ! CHECK: BlockData
 block data
   integer, parameter :: n = 100
   integer, dimension(n) :: a, b, c
   common /arrays/ a, b, c
 end
-! CHECK: EndBlockData
+! CHECK: End BlockData
 
 ! CHECK: ModuleLike
 module test_mod
 interface
   ! check specification parts are not part of the PFT.
   ! CHECK-NOT: node
   module subroutine dump()
   end subroutine
 end interface
  integer :: xdim
  real, allocatable :: pressure(:)
 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
 11  format (2E16.4, I6)
     ! CHECK: <<IfConstruct>>
     ! CHECK: IfThenStmt
     if (xdim > 100) then
       ! CHECK: PrintStmt
       print *, "test: ", xdim
     ! CHECK: ElseStmt
     else
       ! CHECK: WriteStmt
       write (*, 11) "test: ", xdim, pressure
     ! CHECK: EndIfStmt
     end if
     ! 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.
   ! CHECK-NOT: node
   use test_mod
   real, allocatable :: x(:)
   ! CHECK: AllocateStmt
   allocate(x(foo2(10, 30)))
 end
-! CHECK: EndProgram
+! CHECK: End Program

flang/test/Lower/pre-fir-tree02.f90

22        call incr(l)
   ! CHECK: <<End ForallConstruct>>
 
   ! CHECK: DeallocateStmt
   deallocate(x)
 end
 
 ! 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)
     real x(..)
     integer :: foo
     ! CHECK: <<SelectRankConstruct!>>
     ! CHECK: SelectRankStmt
     select rank(x)
function bar(x)
     class(*) :: x
     ! CHECK: <<SelectTypeConstruct!>>
     ! CHECK: SelectTypeStmt
     select type(x)
       ! CHECK: TypeGuardStmt
       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
         bar = -1
     ! CHECK: EndSelectStmt
     end select
     ! CHECK: <<End SelectTypeConstruct!>>
   end function

  entry sub4entry()
  print *, "test"
 end subroutine
 
 ! CHECK: Subroutine sub4
 subroutine sub4()
   integer :: i
   print*, "test"
-  ! CHECK: DataStmt
   data i /1/
 end subroutine

flang/test/Lower/pre-fir-tree04.f90

-! 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
 
 ! CHECK: Subroutine test_coarray
 Subroutine test_coarray
   use iso_fortran_env, only: team_type, event_type, lock_type
   type(team_type) :: t
   type(event_type) :: done

flang/test/Lower/pre-fir-tree05.f90

do i=1,5
     ! CHECK-NEXT: <<End DoConstruct>>
     end do
   ! CHECK-NEXT: EndDoStmt
   ! CHECK-NEXT: <<End DoConstruct>>
   end do
   !$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()
   ! CHECK-NEXT: <<OpenACCConstruct>>
   !$acc parallel loop
   ! CHECK-NEXT: <<DoConstruct>>
   ! CHECK-NEXT: NonLabelDoStmt
   do i=1,5
   ! CHECK-NEXT: EndDoStmt
   ! CHECK-NEXT: <<End DoConstruct>>
   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