aboutsummaryrefslogtreecommitdiff
path: root/flang/lib
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib')
-rw-r--r--flang/lib/Evaluate/tools.cpp34
-rw-r--r--flang/lib/Lower/Bridge.cpp33
-rw-r--r--flang/lib/Lower/OpenACC.cpp395
-rw-r--r--flang/lib/Lower/OpenMP/Atomic.cpp5
-rw-r--r--flang/lib/Lower/OpenMP/OpenMP.cpp51
-rw-r--r--flang/lib/Optimizer/Support/CMakeLists.txt9
-rw-r--r--flang/lib/Semantics/check-acc-structure.cpp226
-rw-r--r--flang/lib/Semantics/check-acc-structure.h16
-rw-r--r--flang/lib/Semantics/check-cuda.cpp9
-rw-r--r--flang/lib/Semantics/check-declarations.cpp4
-rw-r--r--flang/lib/Semantics/check-omp-atomic.cpp13
-rw-r--r--flang/lib/Semantics/expression.cpp77
-rw-r--r--flang/lib/Semantics/openmp-utils.cpp26
-rw-r--r--flang/lib/Semantics/openmp-utils.h1
-rw-r--r--flang/lib/Semantics/pointer-assignment.cpp16
15 files changed, 697 insertions, 218 deletions
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 21e6b3c..171dd91 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1809,10 +1809,15 @@ operation::Operator operation::OperationCode(const ProcedureDesignator &proc) {
}
std::pair<operation::Operator, std::vector<Expr<SomeType>>>
-GetTopLevelOperation(const Expr<SomeType> &expr) {
+GetTopLevelOperationIgnoreResizing(const Expr<SomeType> &expr) {
return operation::ArgumentExtractor<true>{}(expr);
}
+std::pair<operation::Operator, std::vector<Expr<SomeType>>>
+GetTopLevelOperation(const Expr<SomeType> &expr) {
+ return operation::ArgumentExtractor<false>{}(expr);
+}
+
namespace operation {
struct ConvertCollector
: public Traverse<ConvertCollector,
@@ -1936,6 +1941,33 @@ bool IsSameOrConvertOf(const Expr<SomeType> &expr, const Expr<SomeType> &x) {
return false;
}
}
+
+struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
+ using Base = evaluate::AnyTraverse<VariableFinder>;
+ using SomeExpr = Expr<SomeType>;
+ VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
+
+ using Base::operator();
+
+ template <typename T>
+ bool operator()(const evaluate::Designator<T> &x) const {
+ return evaluate::AsGenericExpr(common::Clone(x)) == var;
+ }
+
+ template <typename T>
+ bool operator()(const evaluate::FunctionRef<T> &x) const {
+ return evaluate::AsGenericExpr(common::Clone(x)) == var;
+ }
+
+private:
+ const SomeExpr &var;
+};
+
+bool IsVarSubexpressionOf(
+ const Expr<SomeType> &sub, const Expr<SomeType> &super) {
+ return VariableFinder{sub}(super);
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index ac3669c..1adfb96 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2167,10 +2167,35 @@ private:
/// - structured and unstructured concurrent loops
void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
setCurrentPositionAt(doConstruct);
- // Collect loop nest information.
- // Generate begin loop code directly for infinite and while loops.
Fortran::lower::pft::Evaluation &eval = getEval();
bool unstructuredContext = eval.lowerAsUnstructured();
+
+ // Loops with induction variables inside OpenACC compute constructs
+ // need special handling to ensure that the IVs are privatized.
+ if (Fortran::lower::isInsideOpenACCComputeConstruct(*builder)) {
+ mlir::Operation *loopOp = Fortran::lower::genOpenACCLoopFromDoConstruct(
+ *this, bridge.getSemanticsContext(), localSymbols, doConstruct, eval);
+ bool success = loopOp != nullptr;
+ if (success) {
+ // Sanity check that the builder insertion point is inside the newly
+ // generated loop.
+ assert(
+ loopOp->getRegion(0).isAncestor(
+ builder->getInsertionPoint()->getBlock()->getParent()) &&
+ "builder insertion point is not inside the newly generated loop");
+
+ // Loop body code.
+ auto iter = eval.getNestedEvaluations().begin();
+ for (auto end = --eval.getNestedEvaluations().end(); iter != end;
+ ++iter)
+ genFIR(*iter, unstructuredContext);
+ return;
+ }
+ // Fall back to normal loop handling.
+ }
+
+ // Collect loop nest information.
+ // Generate begin loop code directly for infinite and while loops.
Fortran::lower::pft::Evaluation &doStmtEval =
eval.getFirstNestedEvaluation();
auto *doStmt = doStmtEval.getIf<Fortran::parser::NonLabelDoStmt>();
@@ -3124,7 +3149,7 @@ private:
Fortran::lower::pft::Evaluation *curEval = &getEval();
if (accLoop || accCombined) {
- int64_t loopCount;
+ uint64_t loopCount;
if (accLoop) {
const Fortran::parser::AccBeginLoopDirective &beginLoopDir =
std::get<Fortran::parser::AccBeginLoopDirective>(accLoop->t);
@@ -3142,7 +3167,7 @@ private:
if (curEval->lowerAsStructured()) {
curEval = &curEval->getFirstNestedEvaluation();
- for (int64_t i = 1; i < loopCount; i++)
+ for (uint64_t i = 1; i < loopCount; i++)
curEval = &*std::next(curEval->getNestedEvaluations().begin());
}
}
diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index 471f368..57ce1d3 100644
--- a/flang/lib/Lower/OpenACC.cpp
+++ b/flang/lib/Lower/OpenACC.cpp
@@ -36,6 +36,7 @@
#include "mlir/IR/MLIRContext.h"
#include "mlir/Support/LLVM.h"
#include "llvm/ADT/STLExtras.h"
+#include "llvm/ADT/ScopeExit.h"
#include "llvm/Frontend/OpenACC/ACC.h.inc"
#include "llvm/Support/CommandLine.h"
#include "llvm/Support/Debug.h"
@@ -2142,6 +2143,168 @@ static void determineDefaultLoopParMode(
}
}
+// Extract loop bounds, steps, induction variables, and privatization info
+// for both DO CONCURRENT and regular do loops
+static void processDoLoopBounds(
+ Fortran::lower::AbstractConverter &converter,
+ mlir::Location currentLocation, Fortran::lower::StatementContext &stmtCtx,
+ fir::FirOpBuilder &builder,
+ const Fortran::parser::DoConstruct &outerDoConstruct,
+ Fortran::lower::pft::Evaluation &eval,
+ llvm::SmallVector<mlir::Value> &lowerbounds,
+ llvm::SmallVector<mlir::Value> &upperbounds,
+ llvm::SmallVector<mlir::Value> &steps,
+ llvm::SmallVector<mlir::Value> &privateOperands,
+ llvm::SmallVector<mlir::Value> &ivPrivate,
+ llvm::SmallVector<mlir::Attribute> &privatizationRecipes,
+ llvm::SmallVector<mlir::Type> &ivTypes,
+ llvm::SmallVector<mlir::Location> &ivLocs,
+ llvm::SmallVector<bool> &inclusiveBounds,
+ llvm::SmallVector<mlir::Location> &locs, uint64_t loopsToProcess) {
+ assert(loopsToProcess > 0 && "expect at least one loop");
+ locs.push_back(currentLocation); // Location of the directive
+ Fortran::lower::pft::Evaluation *crtEval = &eval.getFirstNestedEvaluation();
+ bool isDoConcurrent = outerDoConstruct.IsDoConcurrent();
+
+ if (isDoConcurrent) {
+ locs.push_back(converter.genLocation(
+ Fortran::parser::FindSourceLocation(outerDoConstruct)));
+ const Fortran::parser::LoopControl *loopControl =
+ &*outerDoConstruct.GetLoopControl();
+ const auto &concurrent =
+ std::get<Fortran::parser::LoopControl::Concurrent>(loopControl->u);
+ if (!std::get<std::list<Fortran::parser::LocalitySpec>>(concurrent.t)
+ .empty())
+ TODO(currentLocation, "DO CONCURRENT with locality spec inside ACC");
+
+ const auto &concurrentHeader =
+ std::get<Fortran::parser::ConcurrentHeader>(concurrent.t);
+ const auto &controls =
+ std::get<std::list<Fortran::parser::ConcurrentControl>>(
+ concurrentHeader.t);
+ for (const auto &control : controls) {
+ lowerbounds.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(std::get<1>(control.t)), stmtCtx)));
+ upperbounds.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(std::get<2>(control.t)), stmtCtx)));
+ if (const auto &expr =
+ std::get<std::optional<Fortran::parser::ScalarIntExpr>>(
+ control.t))
+ steps.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(*expr), stmtCtx)));
+ else // If `step` is not present, assume it is `1`.
+ steps.push_back(builder.createIntegerConstant(
+ currentLocation, upperbounds[upperbounds.size() - 1].getType(), 1));
+
+ const auto &name = std::get<Fortran::parser::Name>(control.t);
+ privatizeIv(converter, *name.symbol, currentLocation, ivTypes, ivLocs,
+ privateOperands, ivPrivate, privatizationRecipes,
+ isDoConcurrent);
+
+ inclusiveBounds.push_back(true);
+ }
+ } else {
+ for (uint64_t i = 0; i < loopsToProcess; ++i) {
+ const Fortran::parser::LoopControl *loopControl;
+ if (i == 0) {
+ loopControl = &*outerDoConstruct.GetLoopControl();
+ locs.push_back(converter.genLocation(
+ Fortran::parser::FindSourceLocation(outerDoConstruct)));
+ } else {
+ auto *doCons = crtEval->getIf<Fortran::parser::DoConstruct>();
+ assert(doCons && "expect do construct");
+ loopControl = &*doCons->GetLoopControl();
+ locs.push_back(converter.genLocation(
+ Fortran::parser::FindSourceLocation(*doCons)));
+ }
+
+ const Fortran::parser::LoopControl::Bounds *bounds =
+ std::get_if<Fortran::parser::LoopControl::Bounds>(&loopControl->u);
+ assert(bounds && "Expected bounds on the loop construct");
+ lowerbounds.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(bounds->lower), stmtCtx)));
+ upperbounds.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(bounds->upper), stmtCtx)));
+ if (bounds->step)
+ steps.push_back(fir::getBase(converter.genExprValue(
+ *Fortran::semantics::GetExpr(bounds->step), stmtCtx)));
+ else // If `step` is not present, assume it is `1`.
+ steps.push_back(builder.createIntegerConstant(
+ currentLocation, upperbounds[upperbounds.size() - 1].getType(), 1));
+
+ Fortran::semantics::Symbol &ivSym =
+ bounds->name.thing.symbol->GetUltimate();
+ privatizeIv(converter, ivSym, currentLocation, ivTypes, ivLocs,
+ privateOperands, ivPrivate, privatizationRecipes);
+
+ inclusiveBounds.push_back(true);
+
+ if (i < loopsToProcess - 1)
+ crtEval = &*std::next(crtEval->getNestedEvaluations().begin());
+ }
+ }
+}
+
+static mlir::acc::LoopOp
+buildACCLoopOp(Fortran::lower::AbstractConverter &converter,
+ mlir::Location currentLocation,
+ Fortran::semantics::SemanticsContext &semanticsContext,
+ Fortran::lower::StatementContext &stmtCtx,
+ const Fortran::parser::DoConstruct &outerDoConstruct,
+ Fortran::lower::pft::Evaluation &eval,
+ llvm::SmallVector<mlir::Value> &privateOperands,
+ llvm::SmallVector<mlir::Attribute> &privatizationRecipes,
+ llvm::SmallVector<mlir::Value> &gangOperands,
+ llvm::SmallVector<mlir::Value> &workerNumOperands,
+ llvm::SmallVector<mlir::Value> &vectorOperands,
+ llvm::SmallVector<mlir::Value> &tileOperands,
+ llvm::SmallVector<mlir::Value> &cacheOperands,
+ llvm::SmallVector<mlir::Value> &reductionOperands,
+ llvm::SmallVector<mlir::Type> &retTy, mlir::Value yieldValue,
+ uint64_t loopsToProcess) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+
+ llvm::SmallVector<mlir::Value> ivPrivate;
+ llvm::SmallVector<mlir::Type> ivTypes;
+ llvm::SmallVector<mlir::Location> ivLocs;
+ llvm::SmallVector<bool> inclusiveBounds;
+ llvm::SmallVector<mlir::Location> locs;
+ llvm::SmallVector<mlir::Value> lowerbounds, upperbounds, steps;
+
+ // Look at the do/do concurrent loops to extract bounds information.
+ processDoLoopBounds(converter, currentLocation, stmtCtx, builder,
+ outerDoConstruct, eval, lowerbounds, upperbounds, steps,
+ privateOperands, ivPrivate, privatizationRecipes, ivTypes,
+ ivLocs, inclusiveBounds, locs, loopsToProcess);
+
+ // Prepare the operand segment size attribute and the operands value range.
+ llvm::SmallVector<mlir::Value> operands;
+ llvm::SmallVector<int32_t> operandSegments;
+ addOperands(operands, operandSegments, lowerbounds);
+ addOperands(operands, operandSegments, upperbounds);
+ addOperands(operands, operandSegments, steps);
+ addOperands(operands, operandSegments, gangOperands);
+ addOperands(operands, operandSegments, workerNumOperands);
+ addOperands(operands, operandSegments, vectorOperands);
+ addOperands(operands, operandSegments, tileOperands);
+ addOperands(operands, operandSegments, cacheOperands);
+ addOperands(operands, operandSegments, privateOperands);
+ addOperands(operands, operandSegments, reductionOperands);
+
+ auto loopOp = createRegionOp<mlir::acc::LoopOp, mlir::acc::YieldOp>(
+ builder, builder.getFusedLoc(locs), currentLocation, eval, operands,
+ operandSegments, /*outerCombined=*/false, retTy, yieldValue, ivTypes,
+ ivLocs);
+
+ for (auto [arg, value] : llvm::zip(
+ loopOp.getLoopRegions().front()->front().getArguments(), ivPrivate))
+ fir::StoreOp::create(builder, currentLocation, arg, value);
+
+ loopOp.setInclusiveUpperbound(inclusiveBounds);
+
+ return loopOp;
+}
+
static mlir::acc::LoopOp createLoopOp(
Fortran::lower::AbstractConverter &converter,
mlir::Location currentLocation,
@@ -2154,9 +2317,9 @@ static mlir::acc::LoopOp createLoopOp(
std::nullopt,
bool needEarlyReturnHandling = false) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- llvm::SmallVector<mlir::Value> tileOperands, privateOperands, ivPrivate,
+ llvm::SmallVector<mlir::Value> tileOperands, privateOperands,
reductionOperands, cacheOperands, vectorOperands, workerNumOperands,
- gangOperands, lowerbounds, upperbounds, steps;
+ gangOperands;
llvm::SmallVector<mlir::Attribute> privatizationRecipes, reductionRecipes;
llvm::SmallVector<int32_t> tileOperandsSegments, gangOperandsSegments;
llvm::SmallVector<int64_t> collapseValues;
@@ -2325,107 +2488,6 @@ static mlir::acc::LoopOp createLoopOp(
}
}
- llvm::SmallVector<mlir::Type> ivTypes;
- llvm::SmallVector<mlir::Location> ivLocs;
- llvm::SmallVector<bool> inclusiveBounds;
- llvm::SmallVector<mlir::Location> locs;
- locs.push_back(currentLocation); // Location of the directive
- Fortran::lower::pft::Evaluation *crtEval = &eval.getFirstNestedEvaluation();
- bool isDoConcurrent = outerDoConstruct.IsDoConcurrent();
- if (isDoConcurrent) {
- locs.push_back(converter.genLocation(
- Fortran::parser::FindSourceLocation(outerDoConstruct)));
- const Fortran::parser::LoopControl *loopControl =
- &*outerDoConstruct.GetLoopControl();
- const auto &concurrent =
- std::get<Fortran::parser::LoopControl::Concurrent>(loopControl->u);
- if (!std::get<std::list<Fortran::parser::LocalitySpec>>(concurrent.t)
- .empty())
- TODO(currentLocation, "DO CONCURRENT with locality spec");
-
- const auto &concurrentHeader =
- std::get<Fortran::parser::ConcurrentHeader>(concurrent.t);
- const auto &controls =
- std::get<std::list<Fortran::parser::ConcurrentControl>>(
- concurrentHeader.t);
- for (const auto &control : controls) {
- lowerbounds.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(std::get<1>(control.t)), stmtCtx)));
- upperbounds.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(std::get<2>(control.t)), stmtCtx)));
- if (const auto &expr =
- std::get<std::optional<Fortran::parser::ScalarIntExpr>>(
- control.t))
- steps.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(*expr), stmtCtx)));
- else // If `step` is not present, assume it is `1`.
- steps.push_back(builder.createIntegerConstant(
- currentLocation, upperbounds[upperbounds.size() - 1].getType(), 1));
-
- const auto &name = std::get<Fortran::parser::Name>(control.t);
- privatizeIv(converter, *name.symbol, currentLocation, ivTypes, ivLocs,
- privateOperands, ivPrivate, privatizationRecipes,
- isDoConcurrent);
-
- inclusiveBounds.push_back(true);
- }
- } else {
- int64_t loopCount =
- Fortran::lower::getLoopCountForCollapseAndTile(accClauseList);
- for (unsigned i = 0; i < loopCount; ++i) {
- const Fortran::parser::LoopControl *loopControl;
- if (i == 0) {
- loopControl = &*outerDoConstruct.GetLoopControl();
- locs.push_back(converter.genLocation(
- Fortran::parser::FindSourceLocation(outerDoConstruct)));
- } else {
- auto *doCons = crtEval->getIf<Fortran::parser::DoConstruct>();
- assert(doCons && "expect do construct");
- loopControl = &*doCons->GetLoopControl();
- locs.push_back(converter.genLocation(
- Fortran::parser::FindSourceLocation(*doCons)));
- }
-
- const Fortran::parser::LoopControl::Bounds *bounds =
- std::get_if<Fortran::parser::LoopControl::Bounds>(&loopControl->u);
- assert(bounds && "Expected bounds on the loop construct");
- lowerbounds.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(bounds->lower), stmtCtx)));
- upperbounds.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(bounds->upper), stmtCtx)));
- if (bounds->step)
- steps.push_back(fir::getBase(converter.genExprValue(
- *Fortran::semantics::GetExpr(bounds->step), stmtCtx)));
- else // If `step` is not present, assume it is `1`.
- steps.push_back(builder.createIntegerConstant(
- currentLocation, upperbounds[upperbounds.size() - 1].getType(), 1));
-
- Fortran::semantics::Symbol &ivSym =
- bounds->name.thing.symbol->GetUltimate();
- privatizeIv(converter, ivSym, currentLocation, ivTypes, ivLocs,
- privateOperands, ivPrivate, privatizationRecipes);
-
- inclusiveBounds.push_back(true);
-
- if (i < loopCount - 1)
- crtEval = &*std::next(crtEval->getNestedEvaluations().begin());
- }
- }
-
- // Prepare the operand segment size attribute and the operands value range.
- llvm::SmallVector<mlir::Value> operands;
- llvm::SmallVector<int32_t> operandSegments;
- addOperands(operands, operandSegments, lowerbounds);
- addOperands(operands, operandSegments, upperbounds);
- addOperands(operands, operandSegments, steps);
- addOperands(operands, operandSegments, gangOperands);
- addOperands(operands, operandSegments, workerNumOperands);
- addOperands(operands, operandSegments, vectorOperands);
- addOperands(operands, operandSegments, tileOperands);
- addOperands(operands, operandSegments, cacheOperands);
- addOperands(operands, operandSegments, privateOperands);
- addOperands(operands, operandSegments, reductionOperands);
-
llvm::SmallVector<mlir::Type> retTy;
mlir::Value yieldValue;
if (needEarlyReturnHandling) {
@@ -2434,16 +2496,13 @@ static mlir::acc::LoopOp createLoopOp(
retTy.push_back(i1Ty);
}
- auto loopOp = createRegionOp<mlir::acc::LoopOp, mlir::acc::YieldOp>(
- builder, builder.getFusedLoc(locs), currentLocation, eval, operands,
- operandSegments, /*outerCombined=*/false, retTy, yieldValue, ivTypes,
- ivLocs);
-
- for (auto [arg, value] : llvm::zip(
- loopOp.getLoopRegions().front()->front().getArguments(), ivPrivate))
- fir::StoreOp::create(builder, currentLocation, arg, value);
-
- loopOp.setInclusiveUpperbound(inclusiveBounds);
+ uint64_t loopsToProcess =
+ Fortran::lower::getLoopCountForCollapseAndTile(accClauseList);
+ auto loopOp = buildACCLoopOp(
+ converter, currentLocation, semanticsContext, stmtCtx, outerDoConstruct,
+ eval, privateOperands, privatizationRecipes, gangOperands,
+ workerNumOperands, vectorOperands, tileOperands, cacheOperands,
+ reductionOperands, retTy, yieldValue, loopsToProcess);
if (!gangDeviceTypes.empty())
loopOp.setGangAttr(builder.getArrayAttr(gangDeviceTypes));
@@ -4899,6 +4958,12 @@ bool Fortran::lower::isInOpenACCLoop(fir::FirOpBuilder &builder) {
return false;
}
+bool Fortran::lower::isInsideOpenACCComputeConstruct(
+ fir::FirOpBuilder &builder) {
+ return mlir::isa_and_nonnull<ACC_COMPUTE_CONSTRUCT_OPS>(
+ mlir::acc::getEnclosingComputeOp(builder.getRegion()));
+}
+
void Fortran::lower::setInsertionPointAfterOpenACCLoopIfInside(
fir::FirOpBuilder &builder) {
if (auto loopOp =
@@ -4913,10 +4978,10 @@ void Fortran::lower::genEarlyReturnInOpenACCLoop(fir::FirOpBuilder &builder,
mlir::acc::YieldOp::create(builder, loc, yieldValue);
}
-int64_t Fortran::lower::getLoopCountForCollapseAndTile(
+uint64_t Fortran::lower::getLoopCountForCollapseAndTile(
const Fortran::parser::AccClauseList &clauseList) {
- int64_t collapseLoopCount = 1;
- int64_t tileLoopCount = 1;
+ uint64_t collapseLoopCount = 1;
+ uint64_t tileLoopCount = 1;
for (const Fortran::parser::AccClause &clause : clauseList.v) {
if (const auto *collapseClause =
std::get_if<Fortran::parser::AccClause::Collapse>(&clause.u)) {
@@ -4935,3 +5000,101 @@ int64_t Fortran::lower::getLoopCountForCollapseAndTile(
return tileLoopCount;
return collapseLoopCount;
}
+
+/// Create an ACC loop operation for a DO construct when inside ACC compute
+/// constructs This serves as a bridge between regular DO construct handling and
+/// ACC loop creation
+mlir::Operation *Fortran::lower::genOpenACCLoopFromDoConstruct(
+ AbstractConverter &converter,
+ Fortran::semantics::SemanticsContext &semanticsContext,
+ Fortran::lower::SymMap &localSymbols,
+ const Fortran::parser::DoConstruct &doConstruct, pft::Evaluation &eval) {
+ // Only convert loops which have induction variables that need privatized.
+ if (!doConstruct.IsDoNormal() && !doConstruct.IsDoConcurrent())
+ return nullptr;
+
+ // If the evaluation is unstructured, then we cannot convert the loop
+ // because acc loop does not have an unstructured form.
+ // TODO: There may be other strategies that can be employed such
+ // as generating acc.private for the loop variables without attaching
+ // them to acc.loop.
+ // For now - generate a not-yet-implemented message because without
+ // privatizing the induction variable, the loop may not execute correctly.
+ // Only do this for `acc kernels` because in `acc parallel`, scalars end
+ // up as implicitly firstprivate.
+ if (eval.lowerAsUnstructured()) {
+ if (mlir::isa_and_present<mlir::acc::KernelsOp>(
+ mlir::acc::getEnclosingComputeOp(
+ converter.getFirOpBuilder().getRegion())))
+ TODO(converter.getCurrentLocation(),
+ "unstructured do loop in acc kernels");
+ return nullptr;
+ }
+
+ // Open up a new scope for the loop variables.
+ localSymbols.pushScope();
+ auto scopeGuard = llvm::make_scope_exit([&]() { localSymbols.popScope(); });
+
+ // Prepare empty operand vectors since there are no associated `acc loop`
+ // clauses with the Fortran do loops being handled here.
+ llvm::SmallVector<mlir::Value> privateOperands, gangOperands,
+ workerNumOperands, vectorOperands, tileOperands, cacheOperands,
+ reductionOperands;
+ llvm::SmallVector<mlir::Attribute> privatizationRecipes;
+ llvm::SmallVector<mlir::Type> retTy;
+ mlir::Value yieldValue;
+ uint64_t loopsToProcess = 1; // Single loop construct
+
+ // Use same mechanism that handles `acc loop` contained do loops to handle
+ // the implicit loop case.
+ Fortran::lower::StatementContext stmtCtx;
+ auto loopOp = buildACCLoopOp(
+ converter, converter.getCurrentLocation(), semanticsContext, stmtCtx,
+ doConstruct, eval, privateOperands, privatizationRecipes, gangOperands,
+ workerNumOperands, vectorOperands, tileOperands, cacheOperands,
+ reductionOperands, retTy, yieldValue, loopsToProcess);
+
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ if (!privatizationRecipes.empty())
+ loopOp.setPrivatizationRecipesAttr(mlir::ArrayAttr::get(
+ converter.getFirOpBuilder().getContext(), privatizationRecipes));
+
+ // Normal do loops which are not annotated with `acc loop` should be
+ // left for analysis by marking with `auto`. This is the case even in the case
+ // of `acc parallel` region because the normal rules of applying `independent`
+ // is only for loops marked with `acc loop`.
+ // For do concurrent loops, the spec says in section 2.17.2:
+ // "When do concurrent appears without a loop construct in a kernels construct
+ // it is treated as if it is annotated with loop auto. If it appears in a
+ // parallel construct or an accelerator routine then it is treated as if it is
+ // annotated with loop independent."
+ // So this means that in all cases we mark with `auto` unless it is a
+ // `do concurrent` in an `acc parallel` construct or it must be `seq` because
+ // it is in an `acc serial` construct.
+ mlir::Operation *accRegionOp =
+ mlir::acc::getEnclosingComputeOp(converter.getFirOpBuilder().getRegion());
+ mlir::acc::LoopParMode parMode =
+ mlir::isa_and_present<mlir::acc::ParallelOp>(accRegionOp) &&
+ doConstruct.IsDoConcurrent()
+ ? mlir::acc::LoopParMode::loop_independent
+ : mlir::isa_and_present<mlir::acc::SerialOp>(accRegionOp)
+ ? mlir::acc::LoopParMode::loop_seq
+ : mlir::acc::LoopParMode::loop_auto;
+
+ // Set the parallel mode based on the computed parMode
+ auto deviceNoneAttr = mlir::acc::DeviceTypeAttr::get(
+ builder.getContext(), mlir::acc::DeviceType::None);
+ auto arrOfDeviceNone =
+ mlir::ArrayAttr::get(builder.getContext(), deviceNoneAttr);
+ if (parMode == mlir::acc::LoopParMode::loop_independent) {
+ loopOp.setIndependentAttr(arrOfDeviceNone);
+ } else if (parMode == mlir::acc::LoopParMode::loop_seq) {
+ loopOp.setSeqAttr(arrOfDeviceNone);
+ } else if (parMode == mlir::acc::LoopParMode::loop_auto) {
+ loopOp.setAuto_Attr(arrOfDeviceNone);
+ } else {
+ llvm_unreachable("Unexpected loop par mode");
+ }
+
+ return loopOp;
+}
diff --git a/flang/lib/Lower/OpenMP/Atomic.cpp b/flang/lib/Lower/OpenMP/Atomic.cpp
index d4f83f5..c9a6dba 100644
--- a/flang/lib/Lower/OpenMP/Atomic.cpp
+++ b/flang/lib/Lower/OpenMP/Atomic.cpp
@@ -607,7 +607,7 @@ genAtomicUpdate(lower::AbstractConverter &converter,
// This must exist by now.
semantics::SomeExpr rhs = assign.rhs;
semantics::SomeExpr input = *evaluate::GetConvertInput(rhs);
- auto [opcode, args] = evaluate::GetTopLevelOperation(input);
+ auto [opcode, args] = evaluate::GetTopLevelOperationIgnoreResizing(input);
assert(!args.empty() && "Update operation without arguments");
// Pass args as an argument to avoid capturing a structured binding.
@@ -625,7 +625,8 @@ genAtomicUpdate(lower::AbstractConverter &converter,
// operations with exactly two (non-optional) arguments.
rhs = genReducedMinMax(rhs, atomArg, args);
input = *evaluate::GetConvertInput(rhs);
- std::tie(opcode, args) = evaluate::GetTopLevelOperation(input);
+ std::tie(opcode, args) =
+ evaluate::GetTopLevelOperationIgnoreResizing(input);
atomArg = nullptr; // No longer valid.
}
for (auto &arg : args) {
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 12089d6..6a4ec77 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -697,20 +697,16 @@ static void threadPrivatizeVars(lower::AbstractConverter &converter,
}
}
-static mlir::Operation *
-createAndSetPrivatizedLoopVar(lower::AbstractConverter &converter,
- mlir::Location loc, mlir::Value indexVal,
- const semantics::Symbol *sym) {
+static mlir::Operation *setLoopVar(lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::Value indexVal,
+ const semantics::Symbol *sym) {
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+
mlir::OpBuilder::InsertPoint insPt = firOpBuilder.saveInsertionPoint();
firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
-
mlir::Type tempTy = converter.genType(*sym);
-
- assert(converter.isPresentShallowLookup(*sym) &&
- "Expected symbol to be in symbol table.");
-
firOpBuilder.restoreInsertionPoint(insPt);
+
mlir::Value cvtVal = firOpBuilder.createConvert(loc, tempTy, indexVal);
hlfir::Entity lhs{converter.getSymbolAddress(*sym)};
@@ -721,6 +717,15 @@ createAndSetPrivatizedLoopVar(lower::AbstractConverter &converter,
return storeOp;
}
+static mlir::Operation *
+createAndSetPrivatizedLoopVar(lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::Value indexVal,
+ const semantics::Symbol *sym) {
+ assert(converter.isPresentShallowLookup(*sym) &&
+ "Expected symbol to be in symbol table.");
+ return setLoopVar(converter, loc, indexVal, sym);
+}
+
// This helper function implements the functionality of "promoting" non-CPTR
// arguments of use_device_ptr to use_device_addr arguments (automagic
// conversion of use_device_ptr -> use_device_addr in these cases). The way we
@@ -1123,6 +1128,11 @@ struct OpWithBodyGenInfo {
return *this;
}
+ OpWithBodyGenInfo &setPrivatize(bool value) {
+ privatize = value;
+ return *this;
+ }
+
/// [inout] converter to use for the clauses.
lower::AbstractConverter &converter;
/// [in] Symbol table
@@ -1149,6 +1159,8 @@ struct OpWithBodyGenInfo {
/// [in] if set to `true`, skip generating nested evaluations and dispatching
/// any further leaf constructs.
bool genSkeletonOnly = false;
+ /// [in] enables handling of privatized variable unless set to `false`.
+ bool privatize = true;
};
/// Create the body (block) for an OpenMP Operation.
@@ -1209,7 +1221,7 @@ static void createBodyOfOp(mlir::Operation &op, const OpWithBodyGenInfo &info,
// code will use the right symbols.
bool isLoop = llvm::omp::getDirectiveAssociation(info.dir) ==
llvm::omp::Association::Loop;
- bool privatize = info.clauses;
+ bool privatize = info.clauses && info.privatize;
firOpBuilder.setInsertionPoint(marker);
std::optional<DataSharingProcessor> tempDsp;
@@ -2083,7 +2095,7 @@ genCanonicalLoopOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
const ConstructQueue &queue,
ConstructQueue::const_iterator item,
llvm::ArrayRef<const semantics::Symbol *> ivs,
- llvm::omp::Directive directive, DataSharingProcessor &dsp) {
+ llvm::omp::Directive directive) {
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
assert(ivs.size() == 1 && "Nested loops not yet implemented");
@@ -2176,10 +2188,8 @@ genCanonicalLoopOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
mlir::Value userVal =
firOpBuilder.create<mlir::arith::AddIOp>(loc, loopLBVar, scaled);
- // The argument is not currently in memory, so make a temporary for the
- // argument, and store it there, then bind that location to the argument.
- mlir::Operation *storeOp =
- createAndSetPrivatizedLoopVar(converter, loc, userVal, iv);
+ // Write loop value to loop variable
+ mlir::Operation *storeOp = setLoopVar(converter, loc, userVal, iv);
firOpBuilder.setInsertionPointAfter(storeOp);
return {iv};
@@ -2190,7 +2200,7 @@ genCanonicalLoopOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
OpWithBodyGenInfo(converter, symTable, semaCtx, loc, nestedEval,
directive)
.setClauses(&item->clauses)
- .setDataSharingProcessor(&dsp)
+ .setPrivatize(false)
.setGenRegionEntryCb(ivCallback),
queue, item, tripcount, cli);
@@ -2216,17 +2226,10 @@ static void genUnrollOp(Fortran::lower::AbstractConverter &converter,
cp.processTODO<clause::Partial, clause::Full>(
loc, llvm::omp::Directive::OMPD_unroll);
- // Even though unroll does not support data-sharing clauses, but this is
- // required to fill the symbol table.
- DataSharingProcessor dsp(converter, semaCtx, item->clauses, eval,
- /*shouldCollectPreDeterminedSymbols=*/true,
- /*useDelayedPrivatization=*/false, symTable);
- dsp.processStep1();
-
// Emit the associated loop
auto canonLoop =
genCanonicalLoopOp(converter, symTable, semaCtx, eval, loc, queue, item,
- iv, llvm::omp::Directive::OMPD_unroll, dsp);
+ iv, llvm::omp::Directive::OMPD_unroll);
// Apply unrolling to it
auto cli = canonLoop.getCli();
diff --git a/flang/lib/Optimizer/Support/CMakeLists.txt b/flang/lib/Optimizer/Support/CMakeLists.txt
index 7ccdd4f..38038e1 100644
--- a/flang/lib/Optimizer/Support/CMakeLists.txt
+++ b/flang/lib/Optimizer/Support/CMakeLists.txt
@@ -1,6 +1,3 @@
-get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
-get_property(extension_libs GLOBAL PROPERTY MLIR_EXTENSION_LIBS)
-
add_flang_library(FIRSupport
DataLayout.cpp
InitFIR.cpp
@@ -23,12 +20,12 @@ add_flang_library(FIRSupport
${extension_libs}
MLIR_LIBS
- ${dialect_libs}
- ${extension_libs}
MLIRBuiltinToLLVMIRTranslation
+ MLIRLLVMToLLVMIRTranslation
MLIROpenACCToLLVMIRTranslation
MLIROpenMPToLLVMIRTranslation
- MLIRLLVMToLLVMIRTranslation
+ MLIRRegisterAllDialects
+ MLIRRegisterAllExtensions
MLIRTargetLLVMIRExport
MLIRTargetLLVMIRImport
)
diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index 9cbea97..77e2b01 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -7,8 +7,15 @@
//===----------------------------------------------------------------------===//
#include "check-acc-structure.h"
#include "flang/Common/enum-set.h"
+#include "flang/Evaluate/tools.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
+#include "flang/Semantics/type.h"
+#include "flang/Support/Fortran.h"
+#include "llvm/Support/AtomicOrdering.h"
+
+#include <optional>
#define CHECK_SIMPLE_CLAUSE(X, Y) \
void AccStructureChecker::Enter(const parser::AccClause::X &) { \
@@ -342,20 +349,219 @@ void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
dirContext_.pop_back();
}
-void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) {
- const parser::AssignmentStmt &assignment{
- std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
- const auto &var{std::get<parser::Variable>(assignment.t)};
- const auto &expr{std::get<parser::Expr>(assignment.t)};
+void AccStructureChecker::CheckAtomicStmt(
+ const parser::AssignmentStmt &assign, const std::string &construct) {
+ const auto &var{std::get<parser::Variable>(assign.t)};
+ const auto &expr{std::get<parser::Expr>(assign.t)};
const auto *rhs{GetExpr(context_, expr)};
const auto *lhs{GetExpr(context_, var)};
- if (lhs && rhs) {
- if (lhs->Rank() != 0)
+
+ if (lhs) {
+ if (lhs->Rank() != 0) {
context_.Say(expr.source,
- "LHS of atomic update statement must be scalar"_err_en_US);
- if (rhs->Rank() != 0)
+ "LHS of atomic %s statement must be scalar"_err_en_US, construct);
+ }
+ // TODO: Check if lhs is intrinsic type.
+ }
+ if (rhs) {
+ if (rhs->Rank() != 0) {
context_.Say(var.GetSource(),
- "RHS of atomic update statement must be scalar"_err_en_US);
+ "RHS of atomic %s statement must be scalar"_err_en_US, construct);
+ }
+ // TODO: Check if rhs is intrinsic type.
+ }
+}
+
+static constexpr evaluate::operation::OperatorSet validAccAtomicUpdateOperators{
+ evaluate::operation::Operator::Add, evaluate::operation::Operator::Mul,
+ evaluate::operation::Operator::Sub, evaluate::operation::Operator::Div,
+ evaluate::operation::Operator::And, evaluate::operation::Operator::Or,
+ evaluate::operation::Operator::Eqv, evaluate::operation::Operator::Neqv,
+ evaluate::operation::Operator::Max, evaluate::operation::Operator::Min};
+
+static bool IsValidAtomicUpdateOperation(
+ const evaluate::operation::Operator &op) {
+ return validAccAtomicUpdateOperators.test(op);
+}
+
+// Couldn't reproduce this behavior with evaluate::UnwrapConvertedExpr which
+// is similar but only works within a single type category.
+static SomeExpr GetExprModuloConversion(const SomeExpr &expr) {
+ const auto [op, args]{evaluate::GetTopLevelOperation(expr)};
+ // Check: if it is a conversion then it must have at least one argument.
+ CHECK(((op != evaluate::operation::Operator::Convert &&
+ op != evaluate::operation::Operator::Resize) ||
+ args.size() >= 1) &&
+ "Invalid conversion operation");
+ if ((op == evaluate::operation::Operator::Convert ||
+ op == evaluate::operation::Operator::Resize) &&
+ args.size() >= 1) {
+ return args[0];
+ }
+ return expr;
+}
+
+void AccStructureChecker::CheckAtomicUpdateStmt(
+ const parser::AssignmentStmt &assign, const SomeExpr &updateVar,
+ const SomeExpr *captureVar) {
+ CheckAtomicStmt(assign, "update");
+ const auto &expr{std::get<parser::Expr>(assign.t)};
+ const auto *rhs{GetExpr(context_, expr)};
+ if (rhs) {
+ const auto [op, args]{
+ evaluate::GetTopLevelOperation(GetExprModuloConversion(*rhs))};
+ if (!IsValidAtomicUpdateOperation(op)) {
+ context_.Say(expr.source,
+ "Invalid atomic update operation, can only use: *, +, -, *, /, and, or, eqv, neqv, max, min, iand, ior, ieor"_err_en_US);
+ } else {
+ bool foundUpdateVar{false};
+ for (const auto &arg : args) {
+ if (updateVar == GetExprModuloConversion(arg)) {
+ if (foundUpdateVar) {
+ context_.Say(expr.source,
+ "The updated variable, %s, cannot appear more than once in the atomic update operation"_err_en_US,
+ updateVar.AsFortran());
+ } else {
+ foundUpdateVar = true;
+ }
+ } else if (evaluate::IsVarSubexpressionOf(updateVar, arg)) {
+ // TODO: Get the source location of arg and point to the individual
+ // argument.
+ context_.Say(expr.source,
+ "Arguments to the atomic update operation cannot reference the updated variable, %s, as a subexpression"_err_en_US,
+ updateVar.AsFortran());
+ }
+ }
+ if (!foundUpdateVar) {
+ context_.Say(expr.source,
+ "The RHS of this atomic update statement must reference the updated variable: %s"_err_en_US,
+ updateVar.AsFortran());
+ }
+ }
+ }
+}
+
+void AccStructureChecker::CheckAtomicWriteStmt(
+ const parser::AssignmentStmt &assign, const SomeExpr &updateVar,
+ const SomeExpr *captureVar) {
+ CheckAtomicStmt(assign, "write");
+ const auto &expr{std::get<parser::Expr>(assign.t)};
+ const auto *rhs{GetExpr(context_, expr)};
+ if (rhs) {
+ if (evaluate::IsVarSubexpressionOf(updateVar, *rhs)) {
+ context_.Say(expr.source,
+ "The RHS of this atomic write statement cannot reference the atomic variable: %s"_err_en_US,
+ updateVar.AsFortran());
+ }
+ }
+}
+
+void AccStructureChecker::CheckAtomicCaptureStmt(
+ const parser::AssignmentStmt &assign, const SomeExpr *updateVar,
+ const SomeExpr &captureVar) {
+ CheckAtomicStmt(assign, "capture");
+}
+
+void AccStructureChecker::Enter(const parser::AccAtomicCapture &capture) {
+ const Fortran::parser::AssignmentStmt &stmt1{
+ std::get<Fortran::parser::AccAtomicCapture::Stmt1>(capture.t)
+ .v.statement};
+ const Fortran::parser::AssignmentStmt &stmt2{
+ std::get<Fortran::parser::AccAtomicCapture::Stmt2>(capture.t)
+ .v.statement};
+ const auto &var1{std::get<parser::Variable>(stmt1.t)};
+ const auto &var2{std::get<parser::Variable>(stmt2.t)};
+ const auto *lhs1{GetExpr(context_, var1)};
+ const auto *lhs2{GetExpr(context_, var2)};
+ if (!lhs1 || !lhs2) {
+ // Not enough information to check.
+ return;
+ }
+ if (*lhs1 == *lhs2) {
+ context_.Say(std::get<parser::Verbatim>(capture.t).source,
+ "The variables assigned in this atomic capture construct must be distinct"_err_en_US);
+ return;
+ }
+ const auto &expr1{std::get<parser::Expr>(stmt1.t)};
+ const auto &expr2{std::get<parser::Expr>(stmt2.t)};
+ const auto *rhs1{GetExpr(context_, expr1)};
+ const auto *rhs2{GetExpr(context_, expr2)};
+ if (!rhs1 || !rhs2) {
+ return;
+ }
+ bool stmt1CapturesLhs2{*lhs2 == GetExprModuloConversion(*rhs1)};
+ bool stmt2CapturesLhs1{*lhs1 == GetExprModuloConversion(*rhs2)};
+ if (stmt1CapturesLhs2 && !stmt2CapturesLhs1) {
+ if (*lhs2 == GetExprModuloConversion(*rhs2)) {
+ // a = b; b = b: Doesn't fit the spec.
+ context_.Say(std::get<parser::Verbatim>(capture.t).source,
+ "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);
+ // TODO: Add attatchment that a = b seems to be a capture,
+ // but b = b is not a valid update or write.
+ } else if (evaluate::IsVarSubexpressionOf(*lhs2, *rhs2)) {
+ // Take v = x; x = <expr w/ x> as capture; update
+ const auto &updateVar{*lhs2};
+ const auto &captureVar{*lhs1};
+ CheckAtomicCaptureStmt(stmt1, &updateVar, captureVar);
+ CheckAtomicUpdateStmt(stmt2, updateVar, &captureVar);
+ } else {
+ // Take v = x; x = <expr w/o x> as capture; write
+ const auto &updateVar{*lhs2};
+ const auto &captureVar{*lhs1};
+ CheckAtomicCaptureStmt(stmt1, &updateVar, captureVar);
+ CheckAtomicWriteStmt(stmt2, updateVar, &captureVar);
+ }
+ } else if (stmt2CapturesLhs1 && !stmt1CapturesLhs2) {
+ if (*lhs1 == GetExprModuloConversion(*rhs1)) {
+ // Error a = a; b = a;
+ context_.Say(var1.GetSource(),
+ "The first assignment in this atomic capture construct doesn't perform a valid update"_err_en_US);
+ // Add attatchment that a = a is not considered an update,
+ // but b = a seems to be a capture.
+ } else {
+ // Take x = <expr>; v = x: as update; capture
+ const auto &updateVar{*lhs1};
+ const auto &captureVar{*lhs2};
+ CheckAtomicUpdateStmt(stmt1, updateVar, &captureVar);
+ CheckAtomicCaptureStmt(stmt2, &updateVar, captureVar);
+ }
+ } else if (stmt1CapturesLhs2 && stmt2CapturesLhs1) {
+ // x1 = x2; x2 = x1; Doesn't fit the spec.
+ context_.Say(std::get<parser::Verbatim>(capture.t).source,
+ "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);
+ // TODO: Add attatchment that both assignments seem to be captures.
+ } else { // !stmt1CapturesLhs2 && !stmt2CapturesLhs1
+ // a = <expr != b>; b = <expr != a>; Doesn't fit the spec
+ context_.Say(std::get<parser::Verbatim>(capture.t).source,
+ "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);
+ // TODO: Add attatchment that neither assignment seems to be a capture.
+ }
+}
+
+void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) {
+ const auto &assign{
+ std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
+ const auto &var{std::get<parser::Variable>(assign.t)};
+ if (const auto *updateVar{GetExpr(context_, var)}) {
+ CheckAtomicUpdateStmt(assign, *updateVar, /*captureVar=*/nullptr);
+ }
+}
+
+void AccStructureChecker::Enter(const parser::AccAtomicWrite &x) {
+ const auto &assign{
+ std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
+ const auto &var{std::get<parser::Variable>(assign.t)};
+ if (const auto *updateVar{GetExpr(context_, var)}) {
+ CheckAtomicWriteStmt(assign, *updateVar, /*captureVar=*/nullptr);
+ }
+}
+
+void AccStructureChecker::Enter(const parser::AccAtomicRead &x) {
+ const auto &assign{
+ std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
+ const auto &var{std::get<parser::Variable>(assign.t)};
+ if (const auto *captureVar{GetExpr(context_, var)}) {
+ CheckAtomicCaptureStmt(assign, /*updateVar=*/nullptr, *captureVar);
}
}
diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h
index 6a9aa01..359f155 100644
--- a/flang/lib/Semantics/check-acc-structure.h
+++ b/flang/lib/Semantics/check-acc-structure.h
@@ -63,6 +63,9 @@ public:
void Enter(const parser::OpenACCCacheConstruct &);
void Leave(const parser::OpenACCCacheConstruct &);
void Enter(const parser::AccAtomicUpdate &);
+ void Enter(const parser::AccAtomicCapture &);
+ void Enter(const parser::AccAtomicWrite &);
+ void Enter(const parser::AccAtomicRead &);
void Enter(const parser::OpenACCEndConstruct &);
// Clauses
@@ -80,6 +83,19 @@ public:
#include "llvm/Frontend/OpenACC/ACC.inc"
private:
+ void CheckAtomicStmt(
+ const parser::AssignmentStmt &assign, const std::string &construct);
+ void CheckAtomicUpdateStmt(const parser::AssignmentStmt &assign,
+ const SomeExpr &updateVar, const SomeExpr *captureVar);
+ void CheckAtomicCaptureStmt(const parser::AssignmentStmt &assign,
+ const SomeExpr *updateVar, const SomeExpr &captureVar);
+ void CheckAtomicWriteStmt(const parser::AssignmentStmt &assign,
+ const SomeExpr &updateVar, const SomeExpr *captureVar);
+ void CheckAtomicUpdateVariable(
+ const parser::Variable &updateVar, const parser::Variable &captureVar);
+ void CheckAtomicCaptureVariable(
+ const parser::Variable &captureVar, const parser::Variable &updateVar);
+
bool CheckAllowedModifier(llvm::acc::Clause clause);
bool IsComputeConstruct(llvm::acc::Directive directive) const;
bool IsInsideComputeConstruct() const;
diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp
index b011476..9b48432 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/flang/lib/Semantics/check-cuda.cpp
@@ -761,14 +761,13 @@ void CUDAChecker::Enter(const parser::AssignmentStmt &x) {
// legal.
if (nbLhs == 0 && nbRhs > 1) {
context_.Say(lhsLoc,
- "More than one reference to a CUDA object on the right hand side of the assigment"_err_en_US);
+ "More than one reference to a CUDA object on the right hand side of the assignment"_err_en_US);
}
- if (Fortran::evaluate::HasCUDADeviceAttrs(assign->lhs) &&
- Fortran::evaluate::HasCUDAImplicitTransfer(assign->rhs)) {
+ if (evaluate::HasCUDADeviceAttrs(assign->lhs) &&
+ evaluate::HasCUDAImplicitTransfer(assign->rhs)) {
if (GetNbOfCUDAManagedOrUnifiedSymbols(assign->lhs) == 1 &&
- GetNbOfCUDAManagedOrUnifiedSymbols(assign->rhs) == 1 &&
- GetNbOfCUDADeviceSymbols(assign->rhs) == 1) {
+ GetNbOfCUDAManagedOrUnifiedSymbols(assign->rhs) == 1 && nbRhs == 1) {
return; // This is a special case handled on the host.
}
context_.Say(lhsLoc, "Unsupported CUDA data transfer"_err_en_US);
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index a2f2906..d769f22 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2081,7 +2081,7 @@ static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) {
}
static bool ConflictsWithIntrinsicOperator(
- const GenericKind &kind, const Procedure &proc) {
+ const GenericKind &kind, const Procedure &proc, SemanticsContext &context) {
if (!kind.IsIntrinsicOperator()) {
return false;
}
@@ -2167,7 +2167,7 @@ bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind,
}
} else if (!checkDefinedOperatorArgs(opName, specific, proc)) {
return false; // error was reported
- } else if (ConflictsWithIntrinsicOperator(kind, proc)) {
+ } else if (ConflictsWithIntrinsicOperator(kind, proc, context_)) {
msg = "%s function '%s' conflicts with intrinsic operator"_err_en_US;
}
if (msg) {
diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index c5ed879..333fad0 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -197,7 +197,8 @@ static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
}
static bool IsCheckForAssociated(const SomeExpr &cond) {
- return GetTopLevelOperation(cond).first == operation::Operator::Associated;
+ return GetTopLevelOperationIgnoreResizing(cond).first ==
+ operation::Operator::Associated;
}
static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
@@ -399,8 +400,8 @@ OmpStructureChecker::CheckUpdateCapture(
// subexpression of the right-hand side.
// 2. An assignment could be a capture (cbc) if the right-hand side is
// a variable (or a function ref), with potential type conversions.
- bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
- bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
+ bool cbu1{IsVarSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
+ bool cbu2{IsVarSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
@@ -607,7 +608,7 @@ void OmpStructureChecker::CheckAtomicUpdateAssignment(
std::pair<operation::Operator, std::vector<SomeExpr>> top{
operation::Operator::Unknown, {}};
if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
- top = GetTopLevelOperation(*maybeInput);
+ top = GetTopLevelOperationIgnoreResizing(*maybeInput);
}
switch (top.first) {
case operation::Operator::Add:
@@ -657,7 +658,7 @@ void OmpStructureChecker::CheckAtomicUpdateAssignment(
if (IsSameOrConvertOf(arg, atom)) {
++count;
} else {
- if (!subExpr && IsSubexpressionOf(atom, arg)) {
+ if (!subExpr && evaluate::IsVarSubexpressionOf(atom, arg)) {
subExpr = arg;
}
nonAtom.push_back(arg);
@@ -715,7 +716,7 @@ void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
CheckAtomicVariable(atom, alsrc);
- auto top{GetTopLevelOperation(cond)};
+ auto top{GetTopLevelOperationIgnoreResizing(cond)};
// Missing arguments to operations would have been diagnosed by now.
switch (top.first) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 1447372..92dbe0e 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -165,10 +165,17 @@ public:
bool CheckForNullPointer(const char *where = "as an operand here");
bool CheckForAssumedRank(const char *where = "as an operand here");
+ bool AnyCUDADeviceData() const;
+ // Returns true if an interface has been defined for an intrinsic operator
+ // with one or more device operands.
+ bool HasDeviceDefinedIntrinsicOpOverride(const char *) const;
+ template <typename E> bool HasDeviceDefinedIntrinsicOpOverride(E opr) const {
+ return HasDeviceDefinedIntrinsicOpOverride(
+ context_.context().languageFeatures().GetNames(opr));
+ }
+
// Find and return a user-defined operator or report an error.
// The provided message is used if there is no such operator.
- // If a definedOpSymbolPtr is provided, the caller must check
- // for its accessibility.
MaybeExpr TryDefinedOp(
const char *, parser::MessageFixedText, bool isUserOp = false);
template <typename E>
@@ -183,6 +190,8 @@ public:
void Dump(llvm::raw_ostream &);
private:
+ bool HasDeviceDefinedIntrinsicOpOverride(
+ const std::vector<const char *> &) const;
MaybeExpr TryDefinedOp(
const std::vector<const char *> &, parser::MessageFixedText);
MaybeExpr TryBoundOp(const Symbol &, int passIndex);
@@ -202,7 +211,7 @@ private:
void SayNoMatch(
const std::string &, bool isAssignment = false, bool isAmbiguous = false);
std::string TypeAsFortran(std::size_t);
- bool AnyUntypedOrMissingOperand();
+ bool AnyUntypedOrMissingOperand() const;
ExpressionAnalyzer &context_;
ActualArguments actuals_;
@@ -4497,13 +4506,20 @@ void ArgumentAnalyzer::Analyze(
bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr,
const DynamicType &leftType, const DynamicType &rightType) const {
CHECK(actuals_.size() == 2);
- return semantics::IsIntrinsicRelational(
- opr, leftType, GetRank(0), rightType, GetRank(1));
+ return !(context_.context().languageFeatures().IsEnabled(
+ common::LanguageFeature::CUDA) &&
+ HasDeviceDefinedIntrinsicOpOverride(opr)) &&
+ semantics::IsIntrinsicRelational(
+ opr, leftType, GetRank(0), rightType, GetRank(1));
}
bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
std::optional<DynamicType> leftType{GetType(0)};
- if (actuals_.size() == 1) {
+ if (context_.context().languageFeatures().IsEnabled(
+ common::LanguageFeature::CUDA) &&
+ HasDeviceDefinedIntrinsicOpOverride(AsFortran(opr))) {
+ return false;
+ } else if (actuals_.size() == 1) {
if (IsBOZLiteral(0)) {
return opr == NumericOperator::Add; // unary '+'
} else {
@@ -4617,6 +4633,53 @@ bool ArgumentAnalyzer::CheckForAssumedRank(const char *where) {
return true;
}
+bool ArgumentAnalyzer::AnyCUDADeviceData() const {
+ for (const std::optional<ActualArgument> &arg : actuals_) {
+ if (arg) {
+ if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
+ if (HasCUDADeviceAttrs(*expr)) {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+
+// Some operations can be defined with explicit non-type-bound interfaces
+// that would erroneously conflict with intrinsic operations in their
+// types and ranks but have one or more dummy arguments with the DEVICE
+// attribute.
+bool ArgumentAnalyzer::HasDeviceDefinedIntrinsicOpOverride(
+ const char *opr) const {
+ if (AnyCUDADeviceData() && !AnyUntypedOrMissingOperand()) {
+ std::string oprNameString{"operator("s + opr + ')'};
+ parser::CharBlock oprName{oprNameString};
+ parser::Messages buffer;
+ auto restorer{context_.GetContextualMessages().SetMessages(buffer)};
+ const auto &scope{context_.context().FindScope(source_)};
+ if (Symbol * generic{scope.FindSymbol(oprName)}) {
+ parser::Name name{generic->name(), generic};
+ const Symbol *resultSymbol{nullptr};
+ if (context_.AnalyzeDefinedOp(
+ name, ActualArguments{actuals_}, resultSymbol)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+bool ArgumentAnalyzer::HasDeviceDefinedIntrinsicOpOverride(
+ const std::vector<const char *> &oprNames) const {
+ for (const char *opr : oprNames) {
+ if (HasDeviceDefinedIntrinsicOpOverride(opr)) {
+ return true;
+ }
+ }
+ return false;
+}
+
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
const char *opr, parser::MessageFixedText error, bool isUserOp) {
if (AnyUntypedOrMissingOperand()) {
@@ -5135,7 +5198,7 @@ std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) {
}
}
-bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() {
+bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() const {
for (const auto &actual : actuals_) {
if (!actual ||
(!actual->GetType() && !IsBareNullPointer(actual->UnwrapExpr()))) {
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index da14507..7a492a4 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -270,28 +270,6 @@ struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
}
};
-struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
- using Base = evaluate::AnyTraverse<VariableFinder>;
- VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
-
- using Base::operator();
-
- template <typename T>
- bool operator()(const evaluate::Designator<T> &x) const {
- auto copy{x};
- return evaluate::AsGenericExpr(std::move(copy)) == var;
- }
-
- template <typename T>
- bool operator()(const evaluate::FunctionRef<T> &x) const {
- auto copy{x};
- return evaluate::AsGenericExpr(std::move(copy)) == var;
- }
-
-private:
- const SomeExpr &var;
-};
-
std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr) {
return DesignatorCollector{}(expr);
}
@@ -380,10 +358,6 @@ const SomeExpr *HasStorageOverlap(
return nullptr;
}
-bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
- return VariableFinder{sub}(super);
-}
-
// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
// to separate cases where the source has something that looks like an
// assignment, but is semantically wrong (diagnosed by general semantic
diff --git a/flang/lib/Semantics/openmp-utils.h b/flang/lib/Semantics/openmp-utils.h
index 001fbeb..b8ad9ed 100644
--- a/flang/lib/Semantics/openmp-utils.h
+++ b/flang/lib/Semantics/openmp-utils.h
@@ -72,7 +72,6 @@ std::optional<bool> IsContiguous(
std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr);
const SomeExpr *HasStorageOverlap(
const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs);
-bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super);
bool IsAssignment(const parser::ActionStmt *x);
bool IsPointerAssignment(const evaluate::Assignment &x);
const parser::Block &GetInnermostExecPart(const parser::Block &block);
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 0908769..e767bf8 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -270,18 +270,18 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
std::optional<MessageFixedText> msg;
const auto &funcResult{proc->functionResult}; // C1025
if (!funcResult) {
- msg = "%s is associated with the non-existent result of reference to"
- " procedure"_err_en_US;
+ msg =
+ "%s is associated with the non-existent result of reference to procedure"_err_en_US;
} else if (CharacterizeProcedure()) {
// Shouldn't be here in this function unless lhs is an object pointer.
- msg = "Procedure %s is associated with the result of a reference to"
- " function '%s' that does not return a procedure pointer"_err_en_US;
+ msg =
+ "Procedure %s is associated with the result of a reference to function '%s' that does not return a procedure pointer"_err_en_US;
} else if (funcResult->IsProcedurePointer()) {
- msg = "Object %s is associated with the result of a reference to"
- " function '%s' that is a procedure pointer"_err_en_US;
+ msg =
+ "Object %s is associated with the result of a reference to function '%s' that is a procedure pointer"_err_en_US;
} else if (!funcResult->attrs.test(FunctionResult::Attr::Pointer)) {
- msg = "%s is associated with the result of a reference to function '%s'"
- " that is a not a pointer"_err_en_US;
+ msg =
+ "%s is associated with the result of a reference to function '%s' that is not a pointer"_err_en_US;
} else if (isContiguous_ &&
!funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
auto restorer{common::ScopedSet(lhs_, symbol)};
generated by cgit v1.1 at 2025-07-30 22:20:09 +0000