[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

137

[nit] Could you add a message here?

199–201

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

200

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

254–263

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

137

Will do.

199–201

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

200

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.

254–263

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

200

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!

254–263

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

 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Support/FIRContext.h"
+#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
 #include "mlir/IR/PatternMatch.h"
 #include "mlir/Transforms/RegionUtils.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-bridge"
 
 static llvm::cl::opt<bool> dumpBeforeFir(
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 && "current evaluation not set");
+    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.
+    // Note that setting the insertion point causes the subsequent function
+    // call to check the existence of terminator in the newBlock.
+    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();
   }
 
   /// Instantiate variable \p var and add it to the symbol map.
   /// See ConvertVariable.cpp.
   void instantiateVar(const Fortran::lower::pft::Variable &var) {
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     builder->setInsertionPointToStart(&func.front());
 
     for (const Fortran::lower::pft::Variable &var :
          funit.getOrderedSymbolTable()) {
       const Fortran::semantics::Symbol &sym = var.getSymbol();
       if (!sym.IsFuncResult() || !funit.primaryResult)
         instantiateVar(var);
     }
+
+    // Create most function blocks in advance.
+    createEmptyGlobalBlocks(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 createEmptyGlobalBlocks(
+      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()) {
+          createEmptyGlobalBlocks(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<cf::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:   cf.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:   cf.br ^[[BB1:.*]]
+! CHECK: ^[[BB1]]:
+! CHECK:   cf.br ^[[BB2:.*]]
+! CHECK: ^[[BB2]]:
+! CHECK:   cf.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:   cf.br ^[[BB2:.*]]
+! CHECK: ^[[BB1:.*]]: //
+! CHECK:   {{.*}} fir.call @_FortranAStopStatement({{.*}}, {{.*}}, {{.*}}) : (i32, i1, i1) -> none
+! CHECK: ^[[BB2]]:
+! CHECK:   cf.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:   cf.br ^[[BB1:.*]]
+! CHECK-NEXT: ^[[BB1]]:
+! CHECK-NEXT:   cf.br ^[[BB2:.*]]
+! CHECK-NEXT: ^[[BB2]]:
+! CHECK-NEXT:   cf.br ^[[BB3:.*]]
+! CHECK-NEXT: ^[[BB3]]:
+! CHECK-NEXT:   cf.br ^[[BB1]]
+! CHECK-NEXT: }