[Flang] Initial lowering of the Fortran Do loop

[kiranchandramohan]

Summary

This patch adds code to lower simple Fortran Do loops with loop control.
Lowering is performed by the the genFIR function when called with a
Fortran::parser::DoConstruct. genFIR function calls genFIRIncrementLoopBegin
then calls functions to lower the body of the loop and finally calls
the function genFIRIncrementLoopEnd. genFIRIncrementLoopBegin is
responsible for creating the FIR do_loop as well as storing the value of
the loop index to the loop variable. genFIRIncrementLoopEnd returns
the incremented value of the loop index and also stores the index value
outside the loop. This is important since the loop variable can be used
outside the loop. Information about a loop is collected in a structure
IncrementLoopInfo.

Note 1: Future patches will bring in lowering for unstructured,
infinite, while loops
Note 2: This patch is part of upstreaming code from the fir-dev branch of
https://github.com/flang-compiler/f18-llvm-project.

Co-authored-by: Eric Schweitz <[e-mail]>
Co-authored-by: Jean Perier <[e-mail]>
Co-authored-by: Val Donaldson <[e-mail]>
Co-authored-by: Peter Klausler <[e-mail]>
Co-authored-by: Valentin Clement <[e-mail]>

[awarzynski]

It's great to see do loop finally making its way into LLVM main, thanks for working on this @kiranchandramohan !

I would really appreciate if you could break the tests into smaller units. Currently, it's quite tricky to follow them. Indeed, do loop itself is quite complex and I think that it would be beneficial to keep the tests to the required minimum. For example, loop_test1 could be split into:

• a test for a most basic do loop (i.e. just the loop),
• a test for a nested do loop,
• a test for do loop with accumulation that depends on the index variable.

I think that 2 nested loops should be enough, unless we know that things change when moving from 2 to 3 nested loops. Also:

• is print ing really required in these tests? (that's adding complexity that's IMHO not really needed here)
• why not use more descriptive names for tests?

Thank you!

flang/test/Lower/loop.f90

104 ↗

(On Diff #424525)

Could you split this into seperate tests?

[schweitz]

In D124277#3472480, @awarzynski wrote:

It's great to see do loop finally making its way into LLVM main, thanks for working on this @kiranchandramohan !

I would really appreciate if you could break the tests into smaller units. Currently, it's quite tricky to follow them. Indeed, do loop itself is quite complex and I think that it would be beneficial to keep the tests to the required minimum. For example, loop_test1 could be split into:

• a test for a most basic do loop (i.e. just the loop),
• a test for a nested do loop,
• a test for do loop with accumulation that depends on the index variable.

I think that 2 nested loops should be enough, unless we know that things change when moving from 2 to 3 nested loops. Also:

• is print ing really required in these tests? (that's adding complexity that's IMHO not really needed here)
• why not use more descriptive names for tests?

Thank you!

I'm not sure I follow this. Kiran's patch is for the conversion of Fortran loops to FIR. It isn't about exercising FIR's DoLoopOp.

Lowering tests ought to include counted DO loops, unstructured loops, DO WHILE, DO CONCURRENT, and DO forever (modulo those already being present). If not, then some sort of justification for not lowering these Fortran constructs should be made, which is what Kiran did in his original description of the patch.

[awarzynski]

In D124277#3472965, @schweitz wrote:

I'm not sure I follow this. Kiran's patch is for the conversion of Fortran loops to FIR. It isn't about exercising FIR's DoLoopOp.

Sorry, it was quite late when I was typing that and perhaps could've been more specific (or used better formatting). To clarify - I meant Fortran's DO loops in all my comments.

Lowering tests ought to include counted DO loops, unstructured loops, DO WHILE, DO CONCURRENT, and DO forever (modulo those already being present). If not, then some sort of justification for not lowering these Fortran constructs should be made, which is what Kiran did in his original description of the patch.

I do believe that it's clear from the patch title and patch description that only DO loops are covered here. Which to me makes a lot of sense.

Going back to my comment, I was suggesting that the following case/test/subroutine:

subroutine loop_test1
  integer :: asum, arr(5,5,5)
  integer :: i, j, k

  do i=1,5
  end do
  print *, i

  asum = 0
  do i=1,5
    do j=1,5
      do k=1,5
        asum = asum + arr(i,j,k)
    end do
  end do
end subroutine loop_test1

is replaced with 3 more basic, isolated, minimised cases/tests (that can be separated though CHECK-LABEL):

subroutine basic_loop
  integer :: i

  do i=1,5
  end do
end subroutine basic_loop

subroutine loop_with_accumulation
  integer :: asum, arr(5)
  integer :: i, j, k

  asum = 0
  asum = asum + arr(i)
end subroutine loop_with_accumulation

subroutine nested_loop
  integer :: i, j

  do i=1,5
    do j=1,5
  end do
end subroutine loop_test1

To me, smaller tests are much easier to read, reasons about and (most importantly), triage. Apart from splitting loop_test1 into 3 subroutines, I'm also suggesting not using print and reducing the number of nested loops from 3 to 2. I'm also suggesting similar refactoring for other test subroutines in "loop.f90".

Btw, @kiranchandramohan, are you intending to use "loop.f90" for all loops or just DO loops? I would prefer multiple files, unless there is some way to split test files (akin to --split-input-file from MLIR).

[kiranchandramohan]

Address @awarzynksi's comments regarding better tests.

[kiranchandramohan]

Thanks @awarzynski for the review comments. The CHECK lines are mostly mechanical and I have tried to keep it all simple (all except one do not have a loop body). The pattern is something like the following, this is probably evident from the first test (simple_loop).
-> there are some constants/variables that are converted to index type. these form the start, end and step values of the loop
-> the fir.do_loop
-> store the mlir value of the index to the loop variable
-> compute the next value of the index and return or pass it to the next iteration
-> outside the loop the final/result value of the index is stored to the loop variable

In D124277#3472480, @awarzynski wrote:

It's great to see do loop finally making its way into LLVM main, thanks for working on this @kiranchandramohan !

+1. What is Fortran without a loop! And more importantly it will mean we can add support for worksharing OpenMP loop.

I would really appreciate if you could break the tests into smaller units. Currently, it's quite tricky to follow them. Indeed, do loop itself is quite complex and I think that it would be beneficial to keep the tests to the required minimum. For example, loop_test1 could be split into:

• a test for a most basic do loop (i.e. just the loop),

Done.

• a test for a nested do loop,
• a test for do loop with accumulation that depends on the index variable.

This still exists as a combined one because it tests that indexing in nested loop works.

I think that 2 nested loops should be enough, unless we know that things change when moving from 2 to 3 nested loops. Also:

I was a bit conflicted about this. While 2-nested is easier to read, 3-nested seem to be in general a better test. Since it is not a strong opinion, I have changed to a 2-nested one.

• is print ing really required in these tests? (that's adding complexity that's IMHO not really needed here)

Only one test uses a print. I needed a user outside the loop, while it could have been anything I don't really think it adds much noise.

• why not use more descriptive names for tests?

No particular reason. I had included a comment and felt that the subroutine name would just be either replicating the same info or giving a weaker version of it.

Btw, @kiranchandramohan, are you intending to use "loop.f90" for all loops or just DO loops? I would prefer multiple files, unless there is some way to split test files (akin to --split-input-file from MLIR).

I have changed the name to do_loop.f90 and will write tests in separate files.

flang/test/Lower/loop.f90

104 ↗

(On Diff #424525)

Done.

[clementval]

In D124277#3474410, @kiranchandramohan wrote:

I think that 2 nested loops should be enough, unless we know that things change when moving from 2 to 3 nested loops. Also:

I was a bit conflicted about this. While 2-nested is easier to read, 3-nested seem to be in general a better test. Since it is not a strong opinion, I have changed to a 2-nested one.

I think 3 nested loops was a better test.

Btw, @kiranchandramohan, are you intending to use "loop.f90" for all loops or just DO loops? I would prefer multiple files, unless there is some way to split test files (akin to --split-input-file from MLIR).

I have changed the name to do_loop.f90 and will write tests in separate files.

I'm not against making test clearer to read but this is again changes that will make the end of upstreaming harder.

[awarzynski]

Thanks for the updates @kiranchandramohan , the tests are so much easier to follow now!

In D124277#3474496, @clementval wrote:

I think 3 nested loops was a better test.

This was not a blocker for me. Since we see this differently, I suggest that Kiran decides what the final version should be.

I have changed the name to do_loop.f90 and will write tests in separate files.

I'm not against making test clearer to read but this is again changes that will make the end of upstreaming harder.

I don't quite see how. This was is not present in fir-dev anyway. Also, since we are near the end, perhaps it's OK to be a bit more relaxed?

In D124277#3474410, @kiranchandramohan wrote:

Thanks @awarzynski for the review comments. The CHECK lines are mostly mechanical and I have tried to keep it all simple (all except one do not have a loop body). The pattern is something like the following, this is probably evident from the first test (simple_loop).
-> there are some constants/variables that are converted to index type. these form the start, end and step values of the loop
-> the fir.do_loop
-> store the mlir value of the index to the loop variable
-> compute the next value of the index and return or pass it to the next iteration
-> outside the loop the final/result value of the index is stored to the loop variable

This comment really helped me understand the tests - perhaps you could include it in the summary?

I've left a few nits, but feel free to ignore. LGTM, thanks!

flang/lib/Lower/Bridge.cpp

617–619

[nit]

flang/test/Lower/do_loop.f90

109

[nit] DELETEME https://mlir.llvm.org/getting_started/TestingGuide/#filecheck-best-practices

118

[nit]

[clementval]

In D124277#3474792, @awarzynski wrote:

I have changed the name to do_loop.f90 and will write tests in separate files.

I'm not against making test clearer to read but this is again changes that will make the end of upstreaming harder.

I don't quite see how. This was is not present in fir-dev anyway. Also, since we are near the end, perhaps it's OK to be a bit more relaxed?

These tests were present in fir-dev in their initial form. Near the end is exactly where it becomes harder to be sure everything is upstreamed if there is lots of noise in the diffs.

[schweitz]

In D124277#3474801, @clementval wrote:

In D124277#3474792, @awarzynski wrote:

I have changed the name to do_loop.f90 and will write tests in separate files.

I'm not against making test clearer to read but this is again changes that will make the end of upstreaming harder.

I don't quite see how. This was is not present in fir-dev anyway. Also, since we are near the end, perhaps it's OK to be a bit more relaxed?

These tests were present in fir-dev in their initial form. Near the end is exactly where it becomes harder to be sure everything is upstreamed if there is lots of noise in the diffs.

+1.

Upstreaming isn't done and it seems self-defeating if the community doesn't at least try to make upstreaming the last pieces go smoothly.

[awarzynski]

In D124277#3474801, @clementval wrote:

These tests were present in fir-dev in their initial form. Near the end is exactly where it becomes harder to be sure everything is upstreamed if there is lots of noise in the diffs.

Hm, there's neither "loop.f90" nor "do_loop.f90" in fir-dev, so I assumed that there were no tests for this. Now I see that there's loops.f90 and loops2.f90, but it seems that tests added by Kiran were written from scratch.

I have no problem in relevant tests from "loops.f90" and "loops2.f90" being copied across so that we keep the diff clean.

In D124277#3474848, @schweitz wrote:

Upstreaming isn't done and it seems self-defeating if the community doesn't at least try to make upstreaming the last pieces go smoothly.

This comment is unjustified. A lot of effort has gone into and is still being devoted to the upstreaming process. If you do see an omission being made, please assume that it is not intentional.

[kiranchandramohan]

@clementval @schweitz Plan is to upstream the loop as a sequence of patches (if possible without code changes). Since the first patch (this one) only brings in a simple loop, the tests in fir-dev were not directly applicable and I decided to write a new one. Since it is a new test file, its name and contents do not matter much.
Once the loop is completely upstreamed, I will upstream all the remaining loop tests if they did not make it along with the code patches.

[clementval]

In D124277#3475129, @kiranchandramohan wrote:

@clementval @schweitz Plan is to upstream the loop as a sequence of patches (if possible without code changes). Since the first patch (this one) only brings in a simple loop, the tests in fir-dev were not directly applicable and I decided to write a new one. Since it is a new test file, its name and contents do not matter much.
Once the loop is completely upstreamed, I will upstream all the remaining loop tests if they did not make it along with the code patches.

@kiranchandramohan Ok. It was not obvious that these tests were not extracted from loops.f90 especially the one with the sum (asum) that is very close. My comment was general about things that we upstream.

[kiranchandramohan]

Changes made while submitting.

flang/test/Lower/do_loop.f90

109

In this case, I am opting for it to stay since we are checking code outside the loop body and the curly separates what is inside and outside.

flang/lib/Lower/Bridge.cpp

static llvm::cl::opt<bool> dumpBeforeFir(
     "fdebug-dump-pre-fir", llvm::cl::init(false),
     llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
 
 static llvm::cl::opt<bool> forceLoopToExecuteOnce(
     "always-execute-loop-body", llvm::cl::init(false),
     llvm::cl::desc("force the body of a loop to execute at least once"));
 
 namespace {
+/// Information for generating a structured or unstructured increment loop.
+struct IncrementLoopInfo {
+  template <typename T>
+  explicit IncrementLoopInfo(Fortran::semantics::Symbol &sym, const T &lower,
+                             const T &upper, const std::optional<T> &step,
+                             bool isUnordered = false)
+      : loopVariableSym{sym}, lowerExpr{Fortran::semantics::GetExpr(lower)},
+        upperExpr{Fortran::semantics::GetExpr(upper)},
+        stepExpr{Fortran::semantics::GetExpr(step)}, isUnordered{isUnordered} {}
+
+  IncrementLoopInfo(IncrementLoopInfo &&) = default;
+  IncrementLoopInfo &operator=(IncrementLoopInfo &&x) { return x; }
+
+  // TODO: change when unstructured loops are also supported
+  bool isStructured() const { return true; }
+
+  mlir::Type getLoopVariableType() const {
+    assert(loopVariable && "must be set");
+    return fir::unwrapRefType(loopVariable.getType());
+  }
+
+  // Data members common to both structured and unstructured loops.
+  const Fortran::semantics::Symbol &loopVariableSym;
+  const Fortran::lower::SomeExpr *lowerExpr;
+  const Fortran::lower::SomeExpr *upperExpr;
+  const Fortran::lower::SomeExpr *stepExpr;
+  bool isUnordered; // do concurrent, forall
+  mlir::Value loopVariable = nullptr;
+  mlir::Value stepValue = nullptr; // possible uses in multiple blocks
+
+  // Data members for structured loops.
+  fir::DoLoopOp doLoop = nullptr;
+
+  // Data members for unstructured loops.
+  // TODO:
+};
+
 /// Helper class to generate the runtime type info global data. This data
 /// is required to describe the derived type to the runtime so that it can
 /// operate over it. It must be ensured this data will be generated for every
 /// derived type lowered in the current translated unit. However, this data
 /// cannot be generated before FuncOp have been created for functions since the
 /// initializers may take their address (e.g for type bound procedures). This
 /// class allows registering all the required runtime type info while it is not
 /// possible to create globals, and to generate this data after function
private:
   /// symbol in registeredTypeInfoSymbols.
   bool skipRegistration = false;
   /// Track symbols symbols processed during and after the registration
   /// to avoid infinite loops between type conversions and global variable
   /// creation.
   llvm::SmallSetVector<Fortran::semantics::SymbolRef, 64> seen;
 };
 
+using IncrementLoopNestInfo = llvm::SmallVector<IncrementLoopInfo>;
 } // namespace
 
 //===----------------------------------------------------------------------===//
 // FirConverter
 //===----------------------------------------------------------------------===//
 
 namespace {
 
fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) {
     return sb.match(
         [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &box) {
           return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(),
                                                  box);
         },
         [&sb](auto &) { return sb.toExtendedValue(); });
   }
 
+  /// Generate the address of loop variable \p sym.
+  mlir::Value genLoopVariableAddress(mlir::Location loc,
+                                     const Fortran::semantics::Symbol &sym) {
+    assert(lookupSymbol(sym) && "loop control variable must already be in map");
+    Fortran::lower::StatementContext stmtCtx;
+    return fir::getBase(
+        genExprAddr(Fortran::evaluate::AsGenericExpr(sym).value(), stmtCtx));
+  }
+
   static bool isNumericScalarCategory(Fortran::common::TypeCategory cat) {
     return cat == Fortran::common::TypeCategory::Integer ||
            cat == Fortran::common::TypeCategory::Real ||
            cat == Fortran::common::TypeCategory::Complex ||
            cat == Fortran::common::TypeCategory::Logical;
   }
   static bool isLogicalCategory(Fortran::common::TypeCategory cat) {
     return cat == Fortran::common::TypeCategory::Logical;
void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
     builder->create<fir::SelectOp>(loc, selectExpr, indexList, blockList);
   }
 
   /// Generate FIR for a DO construct.  There are six variants:
   ///  - unstructured infinite and while loops
   ///  - structured and unstructured increment loops
   ///  - structured and unstructured concurrent loops
   void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
-    TODO(toLocation(), "DoConstruct lowering");
+    setCurrentPositionAt(doConstruct);
+    // Collect loop nest information.
+    // Generate begin loop code directly for infinite and while loops.
+    Fortran::lower::pft::Evaluation &eval = getEval();
+    Fortran::lower::pft::Evaluation &doStmtEval =
+        eval.getFirstNestedEvaluation();
+    auto *doStmt = doStmtEval.getIf<Fortran::parser::NonLabelDoStmt>();
+    const auto &loopControl =
+        std::get<std::optional<Fortran::parser::LoopControl>>(doStmt->t);
+    IncrementLoopNestInfo incrementLoopNestInfo;
+    if (const auto *bounds = std::get_if<Fortran::parser::LoopControl::Bounds>(
+            &loopControl->u)) {
+      // Non-concurrent increment loop.
+      incrementLoopNestInfo.emplace_back(*bounds->name.thing.symbol,
+                                         bounds->lower, bounds->upper,
+                                         bounds->step);
+      // TODO: unstructured loop
+    } else {
+      TODO(toLocation(), "infinite/unstructured loop/concurrent loop");
+    }
+
+    // Increment loop begin code.  (TODO: Infinite/while code was already
+    // generated.)
+    genFIRIncrementLoopBegin(incrementLoopNestInfo);
+
+    // Loop body code - NonLabelDoStmt and EndDoStmt code is generated here.
+    // Their genFIR calls are nops except for block management in some cases.
+    for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations())
+      genFIR(e, /*unstructuredContext=*/false);
+
+    // Loop end code. (TODO: infinite/while loop)
+    genFIRIncrementLoopEnd(incrementLoopNestInfo);
+  }
+
+  /// Generate FIR to begin a structured or unstructured increment loop nest.
+  void genFIRIncrementLoopBegin(IncrementLoopNestInfo &incrementLoopNestInfo) {
+    assert(!incrementLoopNestInfo.empty() && "empty loop nest");
+    mlir::Location loc = toLocation();
+    auto genControlValue = [&](const Fortran::lower::SomeExpr *expr,
+                               const IncrementLoopInfo &info) {
+      mlir::Type controlType = info.isStructured() ? builder->getIndexType()
+                                                   : info.getLoopVariableType();
+      Fortran::lower::StatementContext stmtCtx;
+      if (expr)
+        return builder->createConvert(loc, controlType,
+                                      createFIRExpr(loc, expr, stmtCtx));
+      return builder->createIntegerConstant(loc, controlType, 1); // step
+    };
+    for (IncrementLoopInfo &info : incrementLoopNestInfo) {
+      info.loopVariable = genLoopVariableAddress(loc, info.loopVariableSym);
+      mlir::Value lowerValue = genControlValue(info.lowerExpr, info);
+      mlir::Value upperValue = genControlValue(info.upperExpr, info);
+      info.stepValue = genControlValue(info.stepExpr, info);
+
+      // Structured loop - generate fir.do_loop.
+      if (info.isStructured()) {
+        info.doLoop = builder->create<fir::DoLoopOp>(
+            loc, lowerValue, upperValue, info.stepValue, info.isUnordered,
+            /*finalCountValue=*/!info.isUnordered);
+        builder->setInsertionPointToStart(info.doLoop.getBody());
+        // Update the loop variable value, as it may have non-index references.
+        mlir::Value value = builder->createConvert(
+            loc, info.getLoopVariableType(), info.doLoop.getInductionVar());
+        builder->create<fir::StoreOp>(loc, value, info.loopVariable);
+        // TODO: Mask expr
+        // TODO: handle Locality Spec
+        continue;
+      }
+      // TODO: Unstructured loop handling
+    }
+  }
+
+  /// Generate FIR to end a structured or unstructured increment loop nest.
+  void genFIRIncrementLoopEnd(IncrementLoopNestInfo &incrementLoopNestInfo) {
+    assert(!incrementLoopNestInfo.empty() && "empty loop nest");
+    mlir::Location loc = toLocation();
+    for (auto it = incrementLoopNestInfo.rbegin(),
+              rend = incrementLoopNestInfo.rend();
+         it != rend; ++it) {
+      IncrementLoopInfo &info = *it;
+      if (info.isStructured()) {
+        // End fir.do_loop.
+        if (!info.isUnordered) {
+          builder->setInsertionPointToEnd(info.doLoop.getBody());
+          mlir::Value result = builder->create<mlir::arith::AddIOp>(
+              loc, info.doLoop.getInductionVar(), info.doLoop.getStep());
+          builder->create<fir::ResultOp>(loc, result);
+        }
+        builder->setInsertionPointAfter(info.doLoop);
+        if (info.isUnordered)
+          continue;
+        // The loop control variable may be used after loop execution.
+        mlir::Value lcv = builder->createConvert(
+            loc, info.getLoopVariableType(), info.doLoop.getResult(0));
+        builder->create<fir::StoreOp>(loc, lcv, info.loopVariable);
+        continue;
+      }
+
+      // TODO: Unstructured loop
+    }
   }
 
   /// Generate structured or unstructured FIR for an IF construct.
   /// The initial statement may be either an IfStmt or an IfThenStmt.
   void genFIR(const Fortran::parser::IfConstruct &) {
     mlir::Location loc = toLocation();
     Fortran::lower::pft::Evaluation &eval = getEval();
     if (eval.lowerAsStructured()) {
#endif
   }
   void genFIR(const Fortran::parser::ExitStmt &) {
     genFIRBranch(getEval().controlSuccessor->block);
   }
   void genFIR(const Fortran::parser::GotoStmt &) {
     genFIRBranch(getEval().controlSuccessor->block);
   }
 
-  void genFIR(const Fortran::parser::EndDoStmt &) {
-    TODO(toLocation(), "EndDoStmt lowering");
-  }
-
   // Nop statements - No code, or code is generated at the construct level.
   void genFIR(const Fortran::parser::AssociateStmt &) {}       // nop
   void genFIR(const Fortran::parser::CaseStmt &) {}            // nop
   void genFIR(const Fortran::parser::ContinueStmt &) {}        // nop
   void genFIR(const Fortran::parser::ElseIfStmt &) {}          // nop
   void genFIR(const Fortran::parser::ElseStmt &) {}            // nop
   void genFIR(const Fortran::parser::EndAssociateStmt &) {}    // nop
+  void genFIR(const Fortran::parser::EndDoStmt &) {}           // nop
   void genFIR(const Fortran::parser::EndFunctionStmt &) {}     // nop
   void genFIR(const Fortran::parser::EndIfStmt &) {}           // nop
   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {} // nop
   void genFIR(const Fortran::parser::EndSelectStmt &) {}       // nop
   void genFIR(const Fortran::parser::EndSubroutineStmt &) {}   // nop
   void genFIR(const Fortran::parser::EntryStmt &) {}           // nop
   void genFIR(const Fortran::parser::IfStmt &) {}              // nop
   void genFIR(const Fortran::parser::IfThenStmt &) {}          // nop
-
-  void genFIR(const Fortran::parser::NonLabelDoStmt &) {
-    TODO(toLocation(), "NonLabelDoStmt lowering");
-  }
+  void genFIR(const Fortran::parser::NonLabelDoStmt &) {}      // nop
 
   void genFIR(const Fortran::parser::OmpEndLoopDirective &) {
     TODO(toLocation(), "OmpEndLoopDirective lowering");
   }
 
   void genFIR(const Fortran::parser::NamelistStmt &) {
     TODO(toLocation(), "NamelistStmt lowering");
   }

flang/test/Lower/do_loop.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+! RUN: %flang_fc1 -emit-fir -o - %s | FileCheck %s
+
+! Simple tests for structured ordered loops with loop-control.
+! Tests the structure of the loop, storage to index variable and return and 
+! storage of the final value of the index variable.
+
+! Test a simple loop with the final value of the index variable read outside the loop
+! CHECK-LABEL: simple_loop
+subroutine simple_loop
+  ! CHECK: %[[I_REF:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFsimple_loopEi"}
+  integer :: i
+
+  ! CHECK: %[[C1:.*]] = arith.constant 1 : i32
+  ! CHECK: %[[C1_CVT:.*]] = fir.convert %c1_i32 : (i32) -> index
+  ! CHECK: %[[C5:.*]] = arith.constant 5 : i32
+  ! CHECK: %[[C5_CVT:.*]] = fir.convert %c5_i32 : (i32) -> index
+  ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+  ! CHECK: %[[LI_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[C1_CVT]] to %[[C5_CVT]] step %[[C1]] -> index {
+  do i=1,5
+  ! CHECK:   %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i32
+  ! CHECK:   fir.store %[[LI_CVT]] to %[[I_REF]] : !fir.ref<i32>
+  ! CHECK:   %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[C1]] : index
+  ! CHECK:  fir.result %[[LI_NEXT]] : index
+  ! CHECK: }
+  end do
+  ! CHECK: %[[LI_RES_CVT:.*]] = fir.convert %[[LI_RES]] : (index) -> i32
+  ! CHECK: fir.store %[[LI_RES_CVT]] to %[[I_REF]] : !fir.ref<i32>
+  ! CHECK: %[[I:.*]] = fir.load %[[I_REF]] : !fir.ref<i32>
+  ! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[I]]) : (!fir.ref<i8>, i32) -> i1
+  print *, i
+end subroutine
+
+! Test a 2-nested loop with a body composed of a reduction. Values are read from a 2d array.
+! CHECK-LABEL: nested_loop
+subroutine nested_loop
+  ! CHECK: %[[ARR_REF:.*]] = fir.alloca !fir.array<5x5xi32> {bindc_name = "arr", uniq_name = "_QFnested_loopEarr"}
+  ! CHECK: %[[ASUM_REF:.*]] = fir.alloca i32 {bindc_name = "asum", uniq_name = "_QFnested_loopEasum"}
+  ! CHECK: %[[I_REF:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFnested_loopEi"}
+  ! CHECK: %[[J_REF:.*]] = fir.alloca i32 {bindc_name = "j", uniq_name = "_QFnested_loopEj"}
+  integer :: asum, arr(5,5)
+  integer :: i, j
+  asum = 0
+  ! CHECK: %[[S_I:.*]] = arith.constant 1 : i32
+  ! CHECK: %[[S_I_CVT:.*]] = fir.convert %[[S_I]] : (i32) -> index
+  ! CHECK: %[[E_I:.*]] = arith.constant 5 : i32
+  ! CHECK: %[[E_I_CVT:.*]] = fir.convert %[[E_I]] : (i32) -> index
+  ! CHECK: %[[ST_I:.*]] = arith.constant 1 : index
+  ! CHECK: %[[I_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[S_I_CVT]] to %[[E_I_CVT]] step %[[ST_I]] -> index {
+  do i=1,5
+    ! CHECK: %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i32
+    ! CHECK: fir.store %[[LI_CVT]] to %[[I_REF]] : !fir.ref<i32>
+    ! CHECK: %[[S_J:.*]] = arith.constant 1 : i32
+    ! CHECK: %[[S_J_CVT:.*]] = fir.convert %[[S_J]] : (i32) -> index
+    ! CHECK: %[[E_J:.*]] = arith.constant 5 : i32
+    ! CHECK: %[[E_J_CVT:.*]] = fir.convert %[[E_J]] : (i32) -> index
+    ! CHECK: %[[ST_J:.*]] = arith.constant 1 : index
+    ! CHECK: %[[J_RES:.*]] = fir.do_loop %[[LJ:.*]] = %[[S_J_CVT]] to %[[E_J_CVT]] step %[[ST_J]] -> index {
+    do j=1,5
+      ! CHECK: %[[LJ_CVT:.*]] = fir.convert %[[LJ]] : (index) -> i32
+      ! CHECK: fir.store %[[LJ_CVT]] to %[[J_REF]] : !fir.ref<i32>
+      ! CHECK: %[[ASUM:.*]] = fir.load %[[ASUM_REF]] : !fir.ref<i32>
+      ! CHECK: %[[I:.*]] = fir.load %[[I_REF]] : !fir.ref<i32>
+      ! CHECK: %[[I_CVT:.*]] = fir.convert %[[I]] : (i32) -> i64
+      ! CHECK: %[[C1_I:.*]] = arith.constant 1 : i64
+      ! CHECK: %[[I_INDX:.*]] = arith.subi %[[I_CVT]], %[[C1_I]] : i64
+      ! CHECK: %[[J:.*]] = fir.load %[[J_REF]] : !fir.ref<i32>
+      ! CHECK: %[[J_CVT:.*]] = fir.convert %[[J]] : (i32) -> i64
+      ! CHECK: %[[C1_J:.*]] = arith.constant 1 : i64
+      ! CHECK: %[[J_INDX:.*]] = arith.subi %[[J_CVT]], %[[C1_J]] : i64
+      ! CHECK: %[[ARR_IJ_REF:.*]] = fir.coordinate_of %[[ARR_REF]], %[[I_INDX]], %[[J_INDX]] : (!fir.ref<!fir.array<5x5xi32>>, i64, i64) -> !fir.ref<i32>
+      ! CHECK: %[[ARR_VAL:.*]] = fir.load %[[ARR_IJ_REF]] : !fir.ref<i32>
+      ! CHECK: %[[ASUM_NEW:.*]] = arith.addi %[[ASUM]], %[[ARR_VAL]] : i32
+      ! CHECK: fir.store %[[ASUM_NEW]] to %[[ASUM_REF]] : !fir.ref<i32>
+      asum = asum + arr(i,j)
+      ! CHECK: %[[LJ_NEXT:.*]] = arith.addi %[[LJ]], %[[ST_J]] : index
+      ! CHECK: fir.result %[[LJ_NEXT]] : index
+    ! CHECK: }
+    end do
+    ! CHECK: %[[J_RES_CVT:.*]] = fir.convert %[[J_RES]] : (index) -> i32
+    ! CHECK: fir.store %[[J_RES_CVT]] to %[[J_REF]] : !fir.ref<i32>
+    ! CHECK: %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[ST_I]] : index
+    ! CHECK: fir.result %[[LI_NEXT]] : index
+  ! CHECK: }
+  end do
+  ! CHECK: %[[I_RES_CVT:.*]] = fir.convert %[[I_RES]] : (index) -> i32
+  ! CHECK: fir.store %[[I_RES_CVT]] to %[[I_REF]] : !fir.ref<i32>
+end subroutine
+
+! Test a downcounting loop
+! CHECK-LABEL: down_counting_loop
+subroutine down_counting_loop()
+  integer :: i
+  ! CHECK: %[[I_REF:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFdown_counting_loopEi"}
+
+  ! CHECK: %[[C5:.*]] = arith.constant 5 : i32
+  ! CHECK: %[[C5_CVT:.*]] = fir.convert %[[C5]] : (i32) -> index
+  ! CHECK: %[[C1:.*]] = arith.constant 1 : i32
+  ! CHECK: %[[C1_CVT:.*]] = fir.convert %[[C1]] : (i32) -> index
+  ! CHECK: %[[CMINUS1:.*]] = arith.constant -1 : i32
+  ! CHECK: %[[CMINUS1_STEP_CVT:.*]] = fir.convert %[[CMINUS1]] : (i32) -> index
+  ! CHECK: %[[I_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[C5_CVT]] to %[[C1_CVT]] step %[[CMINUS1_STEP_CVT]] -> index {
+  do i=5,1,-1
+  ! CHECK: %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i32
+  ! CHECK: fir.store %[[LI_CVT]] to %[[I_REF]] : !fir.ref<i32>
+  ! CHECK: %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[CMINUS1_STEP_CVT]] : index
+  ! CHECK: fir.result %[[LI_NEXT]] : index
+  ! CHECK: }
+  end do
+  ! CHECK: %[[I_RES_CVT:.*]] = fir.convert %[[I_RES]] : (index) -> i32
+  ! CHECK: fir.store %[[I_RES_CVT]] to %[[I_REF]] : !fir.ref<i32>
+end subroutine
+
+! Test a general loop with a variable step
+! CHECK-LABEL: loop_with_variable_step
+! CHECK-SAME: (%[[S_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "s"}, %[[E_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "e"}, %[[ST_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "st"}) {
+subroutine loop_with_variable_step(s,e,st)
+  integer :: s, e, st
+  ! CHECK: %[[S:.*]] = fir.load %[[S_REF]] : !fir.ref<i32>
+  ! CHECK: %[[S_CVT:.*]] = fir.convert %[[S]] : (i32) -> index
+  ! CHECK: %[[E:.*]] = fir.load %[[E_REF]] : !fir.ref<i32>
+  ! CHECK: %[[E_CVT:.*]] = fir.convert %[[E]] : (i32) -> index
+  ! CHECK: %[[ST:.*]] = fir.load %[[ST_REF]] : !fir.ref<i32>
+  ! CHECK: %[[ST_CVT:.*]] = fir.convert %[[ST]] : (i32) -> index
+  ! CHECK: %[[I_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[S_CVT]] to %[[E_CVT]] step %[[ST_CVT]] -> index {
+  do i=s,e,st
+  ! CHECK:  %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i32
+  ! CHECK:  fir.store %[[LI_CVT]] to %[[I_REF]] : !fir.ref<i32>
+  ! CHECK:  %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[ST_CVT]] : index
+  ! CHECK:  fir.result %[[LI_NEXT]] : index
+  ! CHECK: }
+  end do
+  ! CHECK: %[[I_RES_CVT:.*]] = fir.convert %[[I_RES]] : (index) -> i32
+  ! CHECK: fir.store %[[I_RES_CVT]] to %[[I_REF]] : !fir.ref<i32>
+end subroutine
+
+! Test usage of pointer variables as index, start, end and step variables
+! CHECK-LABEL: loop_with_pointer_variables
+! CHECK-SAME: (%[[S_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "s", fir.target}, %[[E_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "e", fir.target}, %[[ST_REF:.*]]: !fir.ref<i32> {fir.bindc_name = "st", fir.target}) {
+subroutine loop_with_pointer_variables(s,e,st)
+! CHECK:  %[[E_PTR_REF:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFloop_with_pointer_variablesEeptr.addr"}
+! CHECK:  %[[I_REF:.*]] = fir.alloca i32 {bindc_name = "i", fir.target, uniq_name = "_QFloop_with_pointer_variablesEi"}
+! CHECK:  %[[I_PTR_REF:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFloop_with_pointer_variablesEiptr.addr"}
+! CHECK:  %[[S_PTR_REF:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFloop_with_pointer_variablesEsptr.addr"}
+! CHECK:  %[[ST_PTR_REF:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFloop_with_pointer_variablesEstptr.addr"}
+  integer, target :: i
+  integer, target :: s, e, st
+  integer, pointer :: iptr, sptr, eptr, stptr
+
+! CHECK:  %[[I_PTR:.*]] = fir.convert %[[I_REF]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:  fir.store %[[I_PTR]] to %[[I_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[S_PTR:.*]] = fir.convert %[[S_REF]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:  fir.store %[[S_PTR]] to %[[S_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[E_PTR:.*]] = fir.convert %[[E_REF]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:  fir.store %[[E_PTR]] to %[[E_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[ST_PTR:.*]] = fir.convert %[[ST_REF]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:  fir.store %[[ST_PTR]] to %[[ST_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+  iptr => i
+  sptr => s
+  eptr => e
+  stptr => st
+
+! CHECK:  %[[I_PTR:.*]] = fir.load %[[I_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[S_PTR:.*]] = fir.load %[[S_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[S:.*]] = fir.load %[[S_PTR]] : !fir.ptr<i32>
+! CHECK:  %[[S_CVT:.*]] = fir.convert %[[S]] : (i32) -> index
+! CHECK:  %[[E_PTR:.*]] = fir.load %[[E_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[E:.*]] = fir.load %[[E_PTR]] : !fir.ptr<i32>
+! CHECK:  %[[E_CVT:.*]] = fir.convert %[[E]] : (i32) -> index
+! CHECK:  %[[ST_PTR:.*]] = fir.load %[[ST_PTR_REF]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:  %[[ST:.*]] = fir.load %[[ST_PTR]] : !fir.ptr<i32>
+! CHECK:  %[[ST_CVT:.*]] = fir.convert %[[ST]] : (i32) -> index
+! CHECK:  %[[I_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[S_CVT]] to %[[E_CVT]] step %[[ST_CVT]] -> index {
+  do iptr=sptr,eptr,stptr
+! CHECK:    %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i32
+! CHECK:    fir.store %[[LI_CVT]] to %[[I_PTR]] : !fir.ptr<i32>
+! CHECK:    %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[ST_CVT]] : index
+! CHECK:    fir.result %[[LI_NEXT]] : index
+  end do
+! CHECK:  }
+! CHECK:  %[[I_RES_CVT:.*]] = fir.convert %[[I_RES]] : (index) -> i32
+! CHECK:  fir.store %[[I_RES_CVT:.*]] to %[[I_PTR]] : !fir.ptr<i32>
+end subroutine
+
+! Test usage of non-default integer kind for loop control and loop index variable
+! CHECK-LABEL: loop_with_non_default_integer
+! CHECK-SAME: (%[[S_REF:.*]]: !fir.ref<i64> {fir.bindc_name = "s"}, %[[E_REF:.*]]: !fir.ref<i64> {fir.bindc_name = "e"}, %[[ST_REF:.*]]: !fir.ref<i64> {fir.bindc_name = "st"}) {
+subroutine loop_with_non_default_integer(s,e,st)
+  ! CHECK: %[[I_REF:.*]] = fir.alloca i64 {bindc_name = "i", uniq_name = "_QFloop_with_non_default_integerEi"}
+  integer(kind=8):: i
+  ! CHECK: %[[S:.*]] = fir.load %[[S_REF]] : !fir.ref<i64>
+  ! CHECK: %[[S_CVT:.*]] = fir.convert %[[S]] : (i64) -> index
+  ! CHECK: %[[E:.*]] = fir.load %[[E_REF]] : !fir.ref<i64>
+  ! CHECK: %[[E_CVT:.*]] = fir.convert %[[E]] : (i64) -> index
+  ! CHECK: %[[ST:.*]] = fir.load %[[ST_REF]] : !fir.ref<i64>
+  ! CHECK: %[[ST_CVT:.*]] = fir.convert %[[ST]] : (i64) -> index
+  integer(kind=8) :: s, e, st
+
+  ! CHECK: %[[I_RES:.*]] = fir.do_loop %[[LI:.*]] = %[[S_CVT]] to %[[E_CVT]] step %[[ST_CVT]] -> index {
+  do i=s,e,st
+    ! CHECK: %[[LI_CVT:.*]] = fir.convert %[[LI]] : (index) -> i64
+    ! CHECK: fir.store %[[LI_CVT]] to %[[I_REF]] : !fir.ref<i64>
+    ! CHECK: %[[LI_NEXT:.*]] = arith.addi %[[LI]], %[[ST_CVT]] : index
+    ! CHECK: fir.result %[[LI_NEXT]] : index
+  end do
+  ! CHECK: }
+  ! CHECK: %[[I_RES_CVT:.*]] = fir.convert %[[I_RES]] : (index) -> i64
+  ! CHECK: fir.store %[[I_RES_CVT]] to %[[I_REF]] : !fir.ref<i64>
+end subroutine