[Flang] Add support for lowering the goto statement

[kiranchandramohan]

Summary

This patch adds support for lowering the Fortran goto statement from
parse-tree to MLIR. The goto statement in Fortran is a form of
unstructured control flow. The statement transfers control to the
code starting at the label specified in the statement. This can be
faithfully represented in MLIR by a branch instruction.

To assist the lowering of code with unstructured control flow, blocks
are created in advance and associated with the relevant pre-fir tree
evaluations.

This is part of the upstreaming effort from the fir-dev branch in [1].

[1] https://github.com/flang-compiler/f18-llvm-project

Originally written by:
Co-authored-by: V Donaldson <[e-mail]>
Co-authored-by: Jean Perier <[e-mail]>
Co-authored-by: Eric Schweitz <[e-mail]>

[awarzynski]

flang/lib/Lower/Bridge.cpp

136

[nit] Could you add a message here?

198–200

Otherwise you might be setting the insertion point more than once, right?

199

Wouldn't genFIRBranch(newBlock) above create a terminator? So that this if condition is always true?

245–254

I don't fully follow this comment. For example, it mentions "global" and "local" blocks, but there's no mention of "global" or "local" in the actual code. Perhaps that's just me?

[kiranchandramohan]

Thanks @awarzynski for the comments.

flang/lib/Lower/Bridge.cpp

136

Will do.

198–200

As mentioned in the previous comment this change will change the block on which the function blockIsUnterminated will be called.

199

Note the setting of insertion point to the newBlock in the line above. So these two are called for different blocks.
I can add a comment if that helps. I was also a bit confused and had to read again.

245–254

The comment just says what kind (= global) of blocks are created here. Blocks are either created due to explicit control-flow (goto like statements) or due to implicit control flow (like the back edges of loops).

They are called global because they can be target of other branch instructions, whereas local blocks are targets of implicit branches that are inside a construct.

Note: I also had to read it twice. But not sure whether the above helps or not.

[clementval]

Thanks for the help. LG

[awarzynski]

Thanks for all the answers, Kiran! Accepting as in, all my suggestions are nits.

flang/lib/Lower/Bridge.cpp

199

Ah, now I see, thanks! getFIRBranch updates the current block. builder->setInsertionPointToStart updates the builder. When reading this function I just assumed that only the current block is updated. My bad.

I can add a comment if that helps.

It would be nice, yes. Not a blocker though!

245–254

Thanks for clarifying, Kiran! I totally missed that from the comment. Perhaps createEmptyGlobalBlocks instead of createEmptyBlocks would make more sense?

[kiranchandramohan]

Rebase, add message with assert, add comment.

flang/lib/Lower/Bridge.cpp

 //===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 //
public:
   mlir::Location toLocation(const Fortran::parser::CharBlock &cb) {
     return genLocation(cb);
   }
 
   mlir::Location toLocation() { return toLocation(currentPosition); }
   void setCurrentEval(Fortran::lower::pft::Evaluation &eval) {
     evalPtr = &eval;
   }
+  Fortran::lower::pft::Evaluation &getEval() {
+    assert(evalPtr);
+    return *evalPtr;
+  }
 
   mlir::Location getCurrentLocation() override final { return toLocation(); }
 
   /// Generate a dummy location.
   mlir::Location genUnknownLocation() override final {
     // Note: builder may not be instantiated yet
     return mlir::UnknownLoc::get(&getMLIRContext());
   }
public:
 
   /// Return the predicate: "current block does not have a terminator branch".
   bool blockIsUnterminated() {
     mlir::Block *currentBlock = builder->getBlock();
     return currentBlock->empty() ||
            !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();
   }
 
+  /// 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);
+    // 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.
+  void maybeStartBlock(mlir::Block *newBlock) {
+    if (newBlock)
+      startBlock(newBlock);
+  }
+
   /// Emit return and cleanup after the function has been translated.
   void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
     if (funit.isMainProgram())
       genExitRoutine();
     else
       genFIRProcedureExit(funit, funit.getSubprogramSymbol());
     funit.finalBlock = nullptr;
     LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
                             << *builder->getFunction() << '\n');
+    // FIXME: Simplification should happen in a normal pass, not here.
+    mlir::IRRewriter rewriter(*builder);
+    (void)mlir::simplifyRegions(rewriter,
+                                {builder->getRegion()}); // remove dead code
     delete builder;
     builder = nullptr;
     localSymbols.clear();
   }
 
   /// Prepare to translate a new function
   void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     assert(!builder && "expected nullptr");
     Fortran::lower::CalleeInterface callee(funit, *this);
     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
     func.setVisibility(mlir::SymbolTable::Visibility::Public);
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     builder->setInsertionPointToStart(&func.front());
+
+    // Create most function blocks in advance.
+    createEmptyBlocks(funit.evaluationList);
+
+    // Reinstate entry block as the current insertion point.
+    builder->setInsertionPointToEnd(&func.front());
+  }
+
+  /// Create global blocks for the current function.  This eliminates the
+  /// distinction between forward and backward targets when generating
+  /// branches.  A block is "global" if it can be the target of a GOTO or
+  /// other source code branch.  A block that can only be targeted by a
+  /// compiler generated branch is "local".  For example, a DO loop preheader
+  /// block containing loop initialization code is global.  A loop header
+  /// block, which is the target of the loop back edge, is local.  Blocks
+  /// belong to a region.  Any block within a nested region must be replaced
+  /// with a block belonging to that region.  Branches may not cross region
+  /// boundaries.
+  void createEmptyBlocks(
+      std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
+    mlir::Region *region = &builder->getRegion();
+    for (Fortran::lower::pft::Evaluation &eval : evaluationList) {
+      if (eval.isNewBlock)
+        eval.block = builder->createBlock(region);
+      if (eval.isConstruct() || eval.isDirective()) {
+        if (eval.lowerAsUnstructured()) {
+          createEmptyBlocks(eval.getNestedEvaluations());
+        } else if (eval.hasNestedEvaluations()) {
+          TODO(toLocation(), "Constructs with nested evaluations");
+        }
+      }
+    }
   }
 
   /// Lower a procedure (nest).
   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
     setCurrentPosition(funit.getStartingSourceLoc());
     for (int entryIndex = 0, last = funit.entryPointList.size();
          entryIndex < last; ++entryIndex) {
       funit.setActiveEntry(entryIndex);
private:
   /// Find the symbol in the local map or return null.
   Fortran::lower::SymbolBox
   lookupSymbol(const Fortran::semantics::Symbol &sym) {
     if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
       return v;
     return {};
   }
 
+  void genFIRBranch(mlir::Block *targetBlock) {
+    assert(targetBlock && "missing unconditional target block");
+    builder->create<mlir::BranchOp>(toLocation(), targetBlock);
+  }
+
   //===--------------------------------------------------------------------===//
   // Termination of symbolically referenced execution units
   //===--------------------------------------------------------------------===//
 
   /// END of program
   ///
   /// Generate the cleanup block before the program exits
   void genExitRoutine() {
void genFIR(const Fortran::parser::CycleStmt &) {
     TODO(toLocation(), "CycleStmt lowering");
   }
 
   void genFIR(const Fortran::parser::ExitStmt &) {
     TODO(toLocation(), "ExitStmt lowering");
   }
 
   void genFIR(const Fortran::parser::GotoStmt &) {
-    TODO(toLocation(), "GotoStmt lowering");
+    genFIRBranch(getEval().controlSuccessor->block);
   }
 
   void genFIR(const Fortran::parser::AssociateStmt &) {
     TODO(toLocation(), "AssociateStmt lowering");
   }
 
   void genFIR(const Fortran::parser::CaseStmt &) {
     TODO(toLocation(), "CaseStmt lowering");
private:
   }
 
   void genFIR(const Fortran::parser::NamelistStmt &) {
     TODO(toLocation(), "NamelistStmt lowering");
   }
 
   void genFIR(Fortran::lower::pft::Evaluation &eval,
               bool unstructuredContext = true) {
+    if (unstructuredContext) {
+      // When transitioning from unstructured to structured code,
+      // the structured code could be a target that starts a new block.
+      maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured()
+                          ? eval.getFirstNestedEvaluation().block
+                          : eval.block);
+    }
+
     setCurrentEval(eval);
     setCurrentPosition(eval.position);
     eval.visit([&](const auto &stmt) { genFIR(stmt); });
   }
 
   //===--------------------------------------------------------------------===//
 
   Fortran::lower::LoweringBridge &bridge;

flang/test/Lower/goto-statement.f90

+! RUN: bbc %s -emit-fir -o - | FileCheck %s
+
+! Test trivial goto statement
+subroutine sub1()
+goto 1
+1 stop
+end subroutine
+! CHECK-LABEL: sub1
+! CHECK:   br ^[[BB1:.*]]
+! CHECK: ^[[BB1]]:
+! CHECK:   {{.*}} fir.call @_FortranAStopStatement({{.*}}, {{.*}}, {{.*}}) : (i32, i1, i1) -> none
+! CHECK: }
+
+! Test multiple goto statements
+subroutine sub2()
+goto 1
+1 goto 2
+2 goto 3
+3 stop
+end subroutine
+! CHECK-LABEL: sub2
+! CHECK:   br ^[[BB1:.*]]
+! CHECK: ^[[BB1]]:
+! CHECK:   br ^[[BB2:.*]]
+! CHECK: ^[[BB2]]:
+! CHECK:   br ^[[BB3:.*]]
+! CHECK: ^[[BB3]]:
+! CHECK:   {{.*}} fir.call @_FortranAStopStatement({{.*}}, {{.*}}, {{.*}}) : (i32, i1, i1) -> none
+! CHECK: }
+
+! Test goto which branches to a previous label
+subroutine sub3()
+pause
+1 goto 3
+2 stop
+3 goto 2
+end subroutine
+! CHECK: sub3
+! CHECK:   {{.*}} fir.call @_FortranAPauseStatement() : () -> none
+! CHECK:   br ^[[BB2:.*]]
+! CHECK: ^[[BB1:.*]]: //
+! CHECK:   {{.*}} fir.call @_FortranAStopStatement({{.*}}, {{.*}}, {{.*}}) : (i32, i1, i1) -> none
+! CHECK: ^[[BB2]]:
+! CHECK:   br ^[[BB1]]
+! CHECK: }
+
+! Test removal of blocks (pauses) which are not reachable
+subroutine sub4()
+pause
+1 goto 2
+pause
+2 goto 3
+pause
+3 goto 1
+pause
+end subroutine
+! CHECK-LABEL: sub4
+! CHECK:   {{.*}} fir.call @_FortranAPauseStatement() : () -> none
+! CHECK-NEXT:   br ^[[BB1:.*]]
+! CHECK-NEXT: ^[[BB1]]:
+! CHECK-NEXT:   br ^[[BB2:.*]]
+! CHECK-NEXT: ^[[BB2]]:
+! CHECK-NEXT:   br ^[[BB3:.*]]
+! CHECK-NEXT: ^[[BB3]]:
+! CHECK-NEXT:   br ^[[BB1]]
+! CHECK-NEXT: }