Unstructured OpenMP code (#1178)

Address several problems with OpenMP constructs and unstructured code.

In fir, code that contains a GOTO, EXIT, or any of a number of other
branches is _unstructured_.  OpenMP generally prohibits branching into
or out of an OpenMP construct, but allows unstructured branches where
the source and target are both local to the construct.  A structured
loop is implemented with a fir.do_loop op, and a structured IF is
implemented with a fir.if op.  Unstructured loops and IFs are implemented
with explicit branches between basic blocks.  This PR allows an OpenMP
construct to immediately follow unstructured code (see PR 1077), and
allows an OpenMP construct to contain unstructured code (see Issue 1120).

The same issues are likely present in OpenACC code.  The infrastructure
changes in this PR should also be valid for OpenACC code, but file
OpenACC.cpp is not changed.

This PR has a partial fix for a problem with nested parallelism, but there
are additional problems to address.

Author: vdonaldson

flang/include/flang/Lower/PFTBuilder.h

@@ -134,9 +134,8 @@ using Constructs =
 
 using Directives =
     std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
-               parser::OpenMPConstruct, parser::OmpEndLoopDirective,
-               parser::OpenMPDeclarativeConstruct,
-               parser::OpenACCDeclarativeConstruct>;
+               parser::OpenACCDeclarativeConstruct, parser::OpenMPConstruct,
+               parser::OpenMPDeclarativeConstruct, parser::OmpEndLoopDirective>;
 
 template <typename A>
 static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
@@ -168,6 +167,11 @@ static constexpr bool isNopConstructStmt{common::HasMember<
                   parser::EndIfStmt, parser::SelectRankCaseStmt,
                   parser::TypeGuardStmt>>};
 
+template <typename A>
+static constexpr bool isExecutableDirective{common::HasMember<
+    A, std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
+                  parser::OpenMPConstruct>>};
+
 template <typename A>
 static constexpr bool isFunctionLike{common::HasMember<
     A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
@@ -246,6 +250,11 @@ struct Evaluation : EvaluationVariant {
       return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
     }});
   }
+  constexpr bool isExecutableDirective() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isExecutableDirective<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.
@@ -297,11 +306,12 @@ struct Evaluation : EvaluationVariant {
 
   // 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.
+  // to these nodes, plus some directives.  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 or directives.  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
@@ -329,8 +339,8 @@ struct Evaluation : EvaluationVariant {
   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 *lexicalSuccessor{nullptr}; // set for leaf nodes, some directives
+  Evaluation *controlSuccessor{nullptr}; // set for some leaf nodes
   Evaluation *constructExit{nullptr};    // set for constructs
   bool isNewBlock{false};                // evaluation begins a new basic block
   bool isUnstructured{false};  // evaluation has unstructured control flow

flang/lib/Lower/Bridge.cpp

@@ -2517,9 +2517,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   /// Unconditionally switch code insertion to a new block.
   void startBlock(mlir::Block *newBlock) {
     assert(newBlock && "missing block");
+    // Default termination for the current block is a fallthrough branch to
+    // the new block.
     if (blockIsUnterminated())
-      genFIRBranch(newBlock); // default termination is a fallthrough branch
-    builder->setInsertionPointToEnd(newBlock); // newBlock might not be empty
+      genFIRBranch(newBlock);
+    // Some blocks may be re/started more than once, and might not be empty.
+    // If the new block already has (only) a terminator, set the insertion
+    // point to the start of the block.  Otherwise set it to the end.
+    builder->setInsertionPointToStart(newBlock);
+    if (blockIsUnterminated())
+      builder->setInsertionPointToEnd(newBlock);
   }
 
   /// Conditionally switch code insertion to a new block.

flang/lib/Lower/OpenMP.cpp

@@ -106,9 +106,42 @@ static void genObjectList(const Fortran::parser::OmpObjectList &objectList,
   }
 }
 
+/// Create empty blocks for the current region.
+/// These blocks replace blocks parented to an enclosing region.
+void createEmptyRegionBlocks(
+    fir::FirOpBuilder &firOpBuilder,
+    std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
+  auto *region = &firOpBuilder.getRegion();
+  for (auto &eval : evaluationList) {
+    if (eval.block) {
+      if (eval.block->empty()) {
+        eval.block->erase();
+        eval.block = firOpBuilder.createBlock(region);
+      } else {
+        [[maybe_unused]] auto &terminatorOp = eval.block->back();
+        assert((mlir::isa<mlir::omp::TerminatorOp>(terminatorOp) ||
+                mlir::isa<mlir::omp::YieldOp>(terminatorOp)) &&
+               "expected terminator op");
+        // FIXME: Some subset of cases may need to insert a branch,
+        // although this could be handled elsewhere.
+        // if (?) {
+        //   auto insertPt = firOpBuilder.saveInsertionPoint();
+        //   firOpBuilder.setInsertionPointAfter(region->getParentOp());
+        //   firOpBuilder.create<mlir::BranchOp>(
+        //       terminatorOp.getLoc(), eval.block);
+        //   firOpBuilder.restoreInsertionPoint(insertPt);
+        // }
+      }
+    }
+    if (eval.hasNestedEvaluations())
+      createEmptyRegionBlocks(firOpBuilder, eval.getNestedEvaluations());
+  }
+}
+
 template <typename Op>
 static void createBodyOfOp(
     Op &op, Fortran::lower::AbstractConverter &converter, mlir::Location &loc,
+    Fortran::lower::pft::Evaluation &eval,
     const Fortran::parser::OmpClauseList *clauses = nullptr,
     const SmallVector<const Fortran::semantics::Symbol *> &args = {}) {
   auto &firOpBuilder = converter.getFirOpBuilder();
@@ -135,6 +168,8 @@ static void createBodyOfOp(
   }
   auto &block = op.getRegion().back();
   firOpBuilder.setInsertionPointToStart(&block);
+  if (eval.lowerAsUnstructured())
+    createEmptyRegionBlocks(firOpBuilder, eval.getNestedEvaluations());
   // Ensure the block is well-formed by inserting terminators.
   if constexpr (std::is_same_v<Op, omp::WsLoopOp>) {
     mlir::ValueRange results;
@@ -331,7 +366,7 @@ static void createParallelOp(Fortran::lower::AbstractConverter &converter,
   // Avoid multiple privatization: If Parallel is part of a combined construct
   // then privatization will be performed later when the other part of the
   // combined construct is processed.
-  createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation,
+  createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation, eval,
                                   isCombined ? nullptr : &opClauseList);
 }
 
@@ -352,7 +387,7 @@ genOMP(Fortran::lower::AbstractConverter &converter,
     auto &firOpBuilder = converter.getFirOpBuilder();
     auto currentLocation = converter.getCurrentLocation();
     auto masterOp = firOpBuilder.create<mlir::omp::MasterOp>(currentLocation);
-    createBodyOfOp<omp::MasterOp>(masterOp, converter, currentLocation);
+    createBodyOfOp<omp::MasterOp>(masterOp, converter, currentLocation, eval);
   }
 }
 
@@ -596,12 +631,13 @@ static void genOMP(Fortran::lower::AbstractConverter &converter,
         wsLoopOp.nowaitAttr(firOpBuilder.getUnitAttr());
   }
 
-  createBodyOfOp<omp::WsLoopOp>(wsLoopOp, converter, currentLocation,
+  createBodyOfOp<omp::WsLoopOp>(wsLoopOp, converter, currentLocation, eval,
                                 &wsLoopOpClauseList, iv);
 }
 
 static void
 genOMP(Fortran::lower::AbstractConverter &converter,
+       Fortran::lower::pft::Evaluation &eval,
        const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) {
   auto &firOpBuilder = converter.getFirOpBuilder();
   auto currentLocation = converter.getCurrentLocation();
@@ -639,7 +675,7 @@ genOMP(Fortran::lower::AbstractConverter &converter,
                                firOpBuilder.getContext(), global.sym_name()));
     }
   }();
-  createBodyOfOp<omp::CriticalOp>(criticalOp, converter, currentLocation);
+  createBodyOfOp<omp::CriticalOp>(criticalOp, converter, currentLocation, eval);
 }
 
 void Fortran::lower::genOpenMPConstruct(
@@ -675,7 +711,9 @@ void Fortran::lower::genOpenMPConstruct(
             TODO(converter.getCurrentLocation(), "OpenMPAtomicConstruct");
           },
           [&](const Fortran::parser::OpenMPCriticalConstruct
-                  &criticalConstruct) { genOMP(converter, criticalConstruct); },
+                  &criticalConstruct) {
+            genOMP(converter, eval, criticalConstruct);
+          },
       },
       ompConstruct.u);
 }

flang/lib/Lower/PFTBuilder.cpp

@@ -296,11 +296,11 @@ class PFTBuilder {
     resetFunctionState();
   }
 
-  /// Initialize a new construct and make it the builder's focus.
+  /// Initialize a new construct or directive and make it the builder's focus.
   template <typename A>
-  bool enterConstructOrDirective(const A &construct) {
-    auto &eval =
-        addEvaluation(lower::pft::Evaluation{construct, pftParentStack.back()});
+  bool enterConstructOrDirective(const A &constructOrDirective) {
+    auto &eval = addEvaluation(
+        lower::pft::Evaluation{constructOrDirective, pftParentStack.back()});
     eval.evaluationList.reset(new lower::pft::EvaluationList);
     pushEvaluationList(eval.evaluationList.get());
     pftParentStack.emplace_back(eval);
@@ -310,6 +310,17 @@ class PFTBuilder {
 
   void exitConstructOrDirective() {
     rewriteIfGotos();
+    auto *eval = constructAndDirectiveStack.back();
+    if (eval->isExecutableDirective()) {
+      // A construct at the end of an (unstructured) OpenACC or OpenMP
+      // construct region must have an exit target inside the region.
+      auto &evaluationList = *eval->evaluationList;
+      if (!evaluationList.empty() && evaluationList.back().isConstruct()) {
+        static const parser::ContinueStmt exitTarget{};
+        addEvaluation(
+            lower::pft::Evaluation{exitTarget, pftParentStack.back(), {}, {}});
+      }
+    }
     popEvaluationList();
     pftParentStack.pop_back();
     constructAndDirectiveStack.pop_back();
@@ -372,7 +383,8 @@ class PFTBuilder {
     auto &entryPointList = eval.getOwningProcedure()->entryPointList;
     evaluationListStack.back()->emplace_back(std::move(eval));
     lower::pft::Evaluation *p = &evaluationListStack.back()->back();
-    if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt()) {
+    if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt() ||
+        p->isExecutableDirective()) {
       if (lastLexicalEvaluation) {
         lastLexicalEvaluation->lexicalSuccessor = p;
         p->printIndex = lastLexicalEvaluation->printIndex + 1;
@@ -1017,33 +1029,32 @@ class PFTDumper {
                       const lower::pft::Evaluation &eval,
                       const std::string &indentString, int indent = 1) {
     llvm::StringRef name = evaluationName(eval);
-    std::string bang = eval.isUnstructured ? "!" : "";
-    if (eval.isConstruct() || eval.isDirective()) {
-      outputStream << indentString << "<<" << name << bang << ">>";
-      if (eval.constructExit)
-        outputStream << " -> " << eval.constructExit->printIndex;
-      outputStream << '\n';
-      dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
-      outputStream << indentString << "<<End " << name << bang << ">>\n";
-      return;
-    }
+    llvm::StringRef newBlock = eval.isNewBlock ? "^" : "";
+    llvm::StringRef bang = eval.isUnstructured ? "!" : "";
     outputStream << indentString;
     if (eval.printIndex)
       outputStream << eval.printIndex << ' ';
-    if (eval.isNewBlock)
-      outputStream << '^';
-    outputStream << name << bang;
-    if (eval.isActionStmt() || eval.isConstructStmt()) {
-      if (eval.negateCondition)
-        outputStream << " [negate]";
-      if (eval.controlSuccessor)
-        outputStream << " -> " << eval.controlSuccessor->printIndex;
-    } else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor) {
+    if (eval.hasNestedEvaluations())
+      outputStream << "<<" << newBlock << name << bang << ">>";
+    else
+      outputStream << newBlock << name << bang;
+    if (eval.negateCondition)
+      outputStream << " [negate]";
+    if (eval.constructExit)
+      outputStream << " -> " << eval.constructExit->printIndex;
+    else if (eval.controlSuccessor)
+      outputStream << " -> " << eval.controlSuccessor->printIndex;
+    else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor)
       outputStream << " -> " << eval.lexicalSuccessor->printIndex;
-    }
     if (!eval.position.empty())
       outputStream << ": " << eval.position.ToString();
+    else if (auto *dir = eval.getIf<Fortran::parser::CompilerDirective>())
+      outputStream << ": !" << dir->source.ToString();
     outputStream << '\n';
+    if (eval.hasNestedEvaluations()) {
+      dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
+      outputStream << indentString << "<<End " << name << bang << ">>\n";
+    }
   }
 
   void dumpEvaluation(llvm::raw_ostream &ostream,

flang/test/Lower/OpenMP/omp-unstructured.f90

@@ -0,0 +1,113 @@
+! Test unstructured code adjacent to and inside OpenMP constructs.
+
+! RUN: bbc %s -fopenmp -o "-" | FileCheck %s
+
+! CHECK-LABEL: func @_QPss1{{.*}} {
+! CHECK:   br ^bb1
+! CHECK: ^bb1:  // 2 preds: ^bb0, ^bb3
+! CHECK:   cond_br %{{[0-9]*}}, ^bb2, ^bb4
+! CHECK: ^bb2:  // pred: ^bb1
+! CHECK:   cond_br %{{[0-9]*}}, ^bb4, ^bb3
+! CHECK: ^bb3:  // pred: ^bb2
+! CHECK:   @_FortranAioBeginExternalListOutput
+! CHECK:   br ^bb1
+! CHECK: ^bb4:  // 2 preds: ^bb1, ^bb2
+! CHECK:   omp.master  {
+! CHECK:     @_FortranAioBeginExternalListOutput
+! CHECK:     omp.terminator
+! CHECK:   }
+! CHECK:   @_FortranAioBeginExternalListOutput
+! CHECK: }
+subroutine ss1(n) ! unstructured code followed by a structured OpenMP construct
+  do i = 1, 3
+    if (i .eq. n) exit
+    print*, 'ss1-A', i
+  enddo
+  !$omp master
+    print*, 'ss1-B', i
+  !$omp end master
+  print*
+end
+
+! CHECK-LABEL: func @_QPss2{{.*}} {
+! CHECK:   omp.master  {
+! CHECK:     @_FortranAioBeginExternalListOutput
+! CHECK:     br ^bb1
+! CHECK:   ^bb1:  // 2 preds: ^bb0, ^bb3
+! CHECK:     cond_br %{{[0-9]*}}, ^bb2, ^bb4
+! CHECK:   ^bb2:  // pred: ^bb1
+! CHECK:     cond_br %{{[0-9]*}}, ^bb4, ^bb3
+! CHECK:   ^bb3:  // pred: ^bb2
+! CHECK:     @_FortranAioBeginExternalListOutput
+! CHECK:     br ^bb1
+! CHECK:   ^bb4:  // 2 preds: ^bb1, ^bb2
+! CHECK:     omp.terminator
+! CHECK:   }
+! CHECK:   @_FortranAioBeginExternalListOutput
+! CHECK:   @_FortranAioBeginExternalListOutput
+! CHECK: }
+subroutine ss2(n) ! unstructured OpenMP construct; loop exit inside construct
+  !$omp master
+    print*, 'ss2-A', n
+    do i = 1, 3
+      if (i .eq. n) exit
+      print*, 'ss2-B', i
+    enddo
+  !$omp end master
+  print*, 'ss2-C', i
+  print*
+end
+
+! CHECK-LABEL: func @_QPss3{{.*}} {
+! CHECK:   omp.parallel  {
+! CHECK:     br ^bb1
+! CHECK:   ^bb1:  // 2 preds: ^bb0, ^bb2
+! CHECK:     cond_br %{{[0-9]*}}, ^bb2, ^bb3
+! CHECK:   ^bb2:  // pred: ^bb1
+! CHECK:     omp.wsloop {{.*}} {
+! CHECK:     @_FortranAioBeginExternalListOutput
+! CHECK:       omp.yield
+! CHECK:     }
+! CHECK:     omp.wsloop {{.*}} {
+! CHECK:       br ^bb1
+! CHECK:     ^bb1:  // 2 preds: ^bb0, ^bb3
+! CHECK:       cond_br %{{[0-9]*}}, ^bb2, ^bb4
+! CHECK:     ^bb2:  // pred: ^bb1
+! CHECK:       cond_br %{{[0-9]*}}, ^bb4, ^bb3
+! CHECK:     ^bb3:  // pred: ^bb2
+! CHECK:       @_FortranAioBeginExternalListOutput
+! CHECK:       br ^bb1
+! CHECK:     ^bb4:  // 2 preds: ^bb1, ^bb2
+! CHECK:       omp.yield
+! CHECK:     }
+! CHECK:     br ^bb1
+! CHECK:   ^bb3:  // pred: ^bb1
+! CHECK:     omp.terminator
+! CHECK:   }
+! CHECK: }
+subroutine ss3(n) ! nested unstructured OpenMP constructs
+  !$omp parallel
+    do i = 1, 3
+      !$omp do
+        do k = 1, 3
+          print*, 'ss3-A', k
+        enddo
+      !$omp end do
+      !$omp do
+        do j = 1, 3
+          do k = 1, 3
+            if (k .eq. n) exit
+            print*, 'ss3-B', k
+          enddo
+        enddo
+      !$omp end do
+    enddo
+  !$omp end parallel
+end
+
+! CHECK-LABEL: func @_QQmain
+program p
+  call ss1(2)
+  call ss2(2)
+  call ss3(2)
+end