Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions flang/include/flang/Lower/PFTBuilder.h
Original file line number Diff line number Diff line change
Expand Up @@ -362,6 +362,7 @@ struct Evaluation : EvaluationVariant {
bool activeConstruct{false}; // temporarily set for some constructs
mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt)
int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
mlir::Operation *op{nullptr}; // associated mlir operation
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If something like this is needed, it probably belongs in struct IncrementLoopInfo near the top of Bridge.cpp. But it probably isn't needed - see other comments.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

+1, there is no one-to-one mapping between a pft::Evaluation and an operation, so it looks weird to me to set this field here in a very generic data structure for a limited use case.

};

using ProgramVariant =
Expand Down
25 changes: 22 additions & 3 deletions flang/lib/Lower/Bridge.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -2012,6 +2012,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
IncrementLoopNestInfo incrementLoopNestInfo;
const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr;
bool infiniteLoop = !loopControl.has_value();
bool isConcurrent = false;
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This looks like the existing IncrementLoopInfo flag isUnordered. That name is the fir terminology. It was originally set up to also be used for the forall case, but now I believe there is a 1-1 correspondence. (If this is needed.)

if (infiniteLoop) {
assert(unstructuredContext && "infinite loop must be unstructured");
startBlock(headerBlock);
Expand Down Expand Up @@ -2042,6 +2043,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
std::get_if<Fortran::parser::LoopControl::Concurrent>(
&loopControl->u);
assert(concurrent && "invalid DO loop variant");
isConcurrent = true;
incrementLoopNestInfo = getConcurrentControl(
std::get<Fortran::parser::ConcurrentHeader>(concurrent->t),
std::get<std::list<Fortran::parser::LocalitySpec>>(concurrent->t));
Expand Down Expand Up @@ -2070,7 +2072,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {

// Increment loop begin code. (Infinite/while code was already generated.)
if (!infiniteLoop && !whileCondition)
genFIRIncrementLoopBegin(incrementLoopNestInfo, doStmtEval.dirs);
genFIRIncrementLoopBegin(incrementLoopNestInfo, doStmtEval.dirs,
isConcurrent);

// Loop body code.
auto iter = eval.getNestedEvaluations().begin();
Expand Down Expand Up @@ -2128,12 +2131,26 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// Generate FIR to begin a structured or unstructured increment loop nest.
void genFIRIncrementLoopBegin(
IncrementLoopNestInfo &incrementLoopNestInfo,
llvm::SmallVectorImpl<const Fortran::parser::CompilerDirective *> &dirs) {
llvm::SmallVectorImpl<const Fortran::parser::CompilerDirective *> &dirs,
bool isConcurrent) {
assert(!incrementLoopNestInfo.empty() && "empty loop nest");
mlir::Location loc = toLocation();
Fortran::lower::pft::Evaluation &eval = getEval();
Fortran::lower::pft::Evaluation *outermostEval = nullptr;
if (isConcurrent) {
outermostEval = &eval;
while (outermostEval->parentConstruct) {
outermostEval = outermostEval->parentConstruct;
}
}
mlir::OpBuilder::InsertPoint insertPt;
for (IncrementLoopInfo &info : incrementLoopNestInfo) {
info.loopVariable =
genLoopVariableAddress(loc, *info.loopVariableSym, info.isUnordered);
if (outermostEval && outermostEval->op) {
insertPt = builder->saveInsertionPoint();
builder->setInsertionPoint(outermostEval->op);
}
mlir::Value lowerValue = genControlValue(info.lowerExpr, info);
mlir::Value upperValue = genControlValue(info.upperExpr, info);
bool isConst = true;
Expand All @@ -2144,7 +2161,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
info.stepVariable = builder->createTemporary(loc, stepValue.getType());
builder->create<fir::StoreOp>(loc, stepValue, info.stepVariable);
}

if (outermostEval && outermostEval->op)
builder->restoreInsertionPoint(insertPt);
// Structured loop - generate fir.do_loop.
if (info.isStructured()) {
mlir::Type loopVarType = info.getLoopVariableType();
Expand Down Expand Up @@ -2179,6 +2197,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->setInsertionPointToStart(info.doLoop.getBody());
loopValue = info.doLoop.getRegionIterArgs()[0];
}
eval.op = info.doLoop;
// Update the loop variable value in case it has non-index references.
builder->create<fir::StoreOp>(loc, loopValue, info.loopVariable);
if (info.maskExpr) {
Expand Down
50 changes: 50 additions & 0 deletions flang/test/Lower/do_concurrent.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
! RUN: %flang_fc1 -emit-hlfir -o - %s | FileCheck %s

! Simple tests for structured concurrent loops with loop-control.

pure function bar(n, m)
implicit none
integer, intent(in) :: n, m
integer :: bar
bar = n + m
end function

subroutine sub1(n)
implicit none
integer :: n, m, i, j
integer, dimension(n) :: a
!CHECK: %[[LB1:.*]] = arith.constant 1 : i32
!CHECK: %[[LB1_CVT:.*]] = fir.convert %[[LB1]] : (i32) -> index
!CHECK: %[[UB1:.*]] = fir.load %5#0 : !fir.ref<i32>
!CHECK: %[[UB1_CVT:.*]] = fir.convert %[[UB1]] : (i32) -> index
!CHECK: %[[LB2:.*]] = arith.constant 1 : i32
!CHECK: %[[LB2_CVT:.*]] = fir.convert %[[LB2]] : (i32) -> index
!CHECK: %[[UB2:.*]] = fir.call @_QPbar(%{{.*}}, %{{.*}}) proc_attrs<pure> fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> i32
!CHECK: %[[UB2_CVT:.*]] = fir.convert %[[UB2]] : (i32) -> index
!CHECK: fir.do_loop %{{.*}} = %[[LB1_CVT]] to %[[UB1_CVT]] step %{{.*}} unordered
!CHECK: fir.do_loop %{{.*}} = %[[LB2_CVT]] to %[[UB2_CVT]] step %{{.*}} unordered
do concurrent(i=1:n, j=1:bar(n*m, n/m))
a(i) = n
end do
end subroutine

subroutine sub2(n)
implicit none
integer :: n, m, i, j
integer, dimension(n) :: a
!CHECK: %[[LB1:.*]] = arith.constant 1 : i32
!CHECK: %[[LB1_CVT:.*]] = fir.convert %[[LB1]] : (i32) -> index
!CHECK: %[[UB1:.*]] = fir.load %5#0 : !fir.ref<i32>
!CHECK: %[[UB1_CVT:.*]] = fir.convert %[[UB1]] : (i32) -> index
!CHECK: %[[LB2:.*]] = arith.constant 1 : i32
!CHECK: %[[LB2_CVT:.*]] = fir.convert %[[LB2]] : (i32) -> index
!CHECK: %[[UB2:.*]] = fir.call @_QPbar(%{{.*}}, %{{.*}}) proc_attrs<pure> fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> i32
!CHECK: %[[UB2_CVT:.*]] = fir.convert %[[UB2]] : (i32) -> index
!CHECK: fir.do_loop %{{.*}} = %[[LB1_CVT]] to %[[UB1_CVT]] step %{{.*}} unordered
!CHECK: fir.do_loop %{{.*}} = %[[LB2_CVT]] to %[[UB2_CVT]] step %{{.*}} unordered
do concurrent(i=1:n)
do concurrent(j=1:bar(n*m, n/m))
a(i) = n
end do
end do
end subroutine
Comment on lines +31 to +50
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This case is different than sub1 since 11.1.7.4.2 does not say that the concurrent limit and steps of all nested do concurrent construct must be performed before the outter constructs.

You can have:

subroutine sub3(a, n)
   implicit none
   integer :: n
   integer, dimension(n, n) :: a
   do concurrent(integer::i=1:n)
      do concurrent(integer::j=1:i)
         a(i, j) = n
      end do
   end do
end subroutine


  integer :: a(4,4) = -1
  call sub3(a, 4)
  print *, a
end

This is a valid program, and with your current patch it will compile to invalid code that will most likely segfault at runtime.

Loading