1074 lines
47 KiB
C++
1074 lines
47 KiB
C++
//===-- Lower/DirectivesCommon.h --------------------------------*- C++ -*-===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
//
|
|
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
///
|
|
/// A location to place directive utilities shared across multiple lowering
|
|
/// files, e.g. utilities shared in OpenMP and OpenACC. The header file can
|
|
/// be used for both declarations and templated/inline implementations
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#ifndef FORTRAN_LOWER_DIRECTIVES_COMMON_H
|
|
#define FORTRAN_LOWER_DIRECTIVES_COMMON_H
|
|
|
|
#include "flang/Common/idioms.h"
|
|
#include "flang/Evaluate/tools.h"
|
|
#include "flang/Lower/AbstractConverter.h"
|
|
#include "flang/Lower/Bridge.h"
|
|
#include "flang/Lower/ConvertExpr.h"
|
|
#include "flang/Lower/ConvertVariable.h"
|
|
#include "flang/Lower/OpenACC.h"
|
|
#include "flang/Lower/OpenMP.h"
|
|
#include "flang/Lower/PFTBuilder.h"
|
|
#include "flang/Lower/StatementContext.h"
|
|
#include "flang/Lower/Support/Utils.h"
|
|
#include "flang/Optimizer/Builder/BoxValue.h"
|
|
#include "flang/Optimizer/Builder/FIRBuilder.h"
|
|
#include "flang/Optimizer/Builder/Todo.h"
|
|
#include "flang/Optimizer/HLFIR/HLFIROps.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
#include "flang/Semantics/openmp-directive-sets.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include "mlir/Dialect/OpenACC/OpenACC.h"
|
|
#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
|
|
#include "mlir/Dialect/SCF/IR/SCF.h"
|
|
#include "mlir/IR/Value.h"
|
|
#include "llvm/Frontend/OpenMP/OMPConstants.h"
|
|
#include <list>
|
|
#include <type_traits>
|
|
|
|
namespace Fortran {
|
|
namespace lower {
|
|
|
|
/// Information gathered to generate bounds operation and data entry/exit
|
|
/// operations.
|
|
struct AddrAndBoundsInfo {
|
|
explicit AddrAndBoundsInfo() {}
|
|
explicit AddrAndBoundsInfo(mlir::Value addr) : addr(addr) {}
|
|
explicit AddrAndBoundsInfo(mlir::Value addr, mlir::Value isPresent)
|
|
: addr(addr), isPresent(isPresent) {}
|
|
mlir::Value addr = nullptr;
|
|
mlir::Value isPresent = nullptr;
|
|
};
|
|
|
|
/// Checks if the assignment statement has a single variable on the RHS.
|
|
static inline bool checkForSingleVariableOnRHS(
|
|
const Fortran::parser::AssignmentStmt &assignmentStmt) {
|
|
const Fortran::parser::Expr &expr{
|
|
std::get<Fortran::parser::Expr>(assignmentStmt.t)};
|
|
const Fortran::common::Indirection<Fortran::parser::Designator> *designator =
|
|
std::get_if<Fortran::common::Indirection<Fortran::parser::Designator>>(
|
|
&expr.u);
|
|
return designator != nullptr;
|
|
}
|
|
|
|
/// Checks if the symbol on the LHS of the assignment statement is present in
|
|
/// the RHS expression.
|
|
static inline bool
|
|
checkForSymbolMatch(const Fortran::parser::AssignmentStmt &assignmentStmt) {
|
|
const auto &var{std::get<Fortran::parser::Variable>(assignmentStmt.t)};
|
|
const auto &expr{std::get<Fortran::parser::Expr>(assignmentStmt.t)};
|
|
const auto *e{Fortran::semantics::GetExpr(expr)};
|
|
const auto *v{Fortran::semantics::GetExpr(var)};
|
|
auto varSyms{Fortran::evaluate::GetSymbolVector(*v)};
|
|
const Fortran::semantics::Symbol &varSymbol{*varSyms.front()};
|
|
for (const Fortran::semantics::Symbol &symbol :
|
|
Fortran::evaluate::GetSymbolVector(*e))
|
|
if (varSymbol == symbol)
|
|
return true;
|
|
return false;
|
|
}
|
|
|
|
/// Populates \p hint and \p memoryOrder with appropriate clause information
|
|
/// if present on atomic construct.
|
|
static inline void genOmpAtomicHintAndMemoryOrderClauses(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::OmpAtomicClauseList &clauseList,
|
|
mlir::IntegerAttr &hint,
|
|
mlir::omp::ClauseMemoryOrderKindAttr &memoryOrder) {
|
|
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
|
|
for (const Fortran::parser::OmpAtomicClause &clause : clauseList.v) {
|
|
if (const auto *ompClause =
|
|
std::get_if<Fortran::parser::OmpClause>(&clause.u)) {
|
|
if (const auto *hintClause =
|
|
std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)) {
|
|
const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
|
|
uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr);
|
|
hint = firOpBuilder.getI64IntegerAttr(hintExprValue);
|
|
}
|
|
} else if (const auto *ompMemoryOrderClause =
|
|
std::get_if<Fortran::parser::OmpMemoryOrderClause>(
|
|
&clause.u)) {
|
|
if (std::get_if<Fortran::parser::OmpClause::Acquire>(
|
|
&ompMemoryOrderClause->v.u)) {
|
|
memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get(
|
|
firOpBuilder.getContext(),
|
|
mlir::omp::ClauseMemoryOrderKind::Acquire);
|
|
} else if (std::get_if<Fortran::parser::OmpClause::Relaxed>(
|
|
&ompMemoryOrderClause->v.u)) {
|
|
memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get(
|
|
firOpBuilder.getContext(),
|
|
mlir::omp::ClauseMemoryOrderKind::Relaxed);
|
|
} else if (std::get_if<Fortran::parser::OmpClause::SeqCst>(
|
|
&ompMemoryOrderClause->v.u)) {
|
|
memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get(
|
|
firOpBuilder.getContext(),
|
|
mlir::omp::ClauseMemoryOrderKind::Seq_cst);
|
|
} else if (std::get_if<Fortran::parser::OmpClause::Release>(
|
|
&ompMemoryOrderClause->v.u)) {
|
|
memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get(
|
|
firOpBuilder.getContext(),
|
|
mlir::omp::ClauseMemoryOrderKind::Release);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
/// Used to generate atomic.read operation which is created in existing
|
|
/// location set by builder.
|
|
template <typename AtomicListT>
|
|
static inline void genOmpAccAtomicCaptureStatement(
|
|
Fortran::lower::AbstractConverter &converter, mlir::Value fromAddress,
|
|
mlir::Value toAddress,
|
|
[[maybe_unused]] const AtomicListT *leftHandClauseList,
|
|
[[maybe_unused]] const AtomicListT *rightHandClauseList,
|
|
mlir::Type elementType, mlir::Location loc) {
|
|
// Generate `atomic.read` operation for atomic assigment statements
|
|
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
|
|
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// If no hint clause is specified, the effect is as if
|
|
// hint(omp_sync_hint_none) had been specified.
|
|
mlir::IntegerAttr hint = nullptr;
|
|
|
|
mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
|
|
if (leftHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList,
|
|
hint, memoryOrder);
|
|
if (rightHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList,
|
|
hint, memoryOrder);
|
|
firOpBuilder.create<mlir::omp::AtomicReadOp>(
|
|
loc, fromAddress, toAddress, mlir::TypeAttr::get(elementType), hint,
|
|
memoryOrder);
|
|
} else {
|
|
firOpBuilder.create<mlir::acc::AtomicReadOp>(
|
|
loc, fromAddress, toAddress, mlir::TypeAttr::get(elementType));
|
|
}
|
|
}
|
|
|
|
/// Used to generate atomic.write operation which is created in existing
|
|
/// location set by builder.
|
|
template <typename AtomicListT>
|
|
static inline void genOmpAccAtomicWriteStatement(
|
|
Fortran::lower::AbstractConverter &converter, mlir::Value lhsAddr,
|
|
mlir::Value rhsExpr, [[maybe_unused]] const AtomicListT *leftHandClauseList,
|
|
[[maybe_unused]] const AtomicListT *rightHandClauseList, mlir::Location loc,
|
|
mlir::Value *evaluatedExprValue = nullptr) {
|
|
// Generate `atomic.write` operation for atomic assignment statements
|
|
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
|
|
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// If no hint clause is specified, the effect is as if
|
|
// hint(omp_sync_hint_none) had been specified.
|
|
mlir::IntegerAttr hint = nullptr;
|
|
mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
|
|
if (leftHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList,
|
|
hint, memoryOrder);
|
|
if (rightHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList,
|
|
hint, memoryOrder);
|
|
firOpBuilder.create<mlir::omp::AtomicWriteOp>(loc, lhsAddr, rhsExpr, hint,
|
|
memoryOrder);
|
|
} else {
|
|
firOpBuilder.create<mlir::acc::AtomicWriteOp>(loc, lhsAddr, rhsExpr);
|
|
}
|
|
}
|
|
|
|
/// Used to generate atomic.update operation which is created in existing
|
|
/// location set by builder.
|
|
template <typename AtomicListT>
|
|
static inline void genOmpAccAtomicUpdateStatement(
|
|
Fortran::lower::AbstractConverter &converter, mlir::Value lhsAddr,
|
|
mlir::Type varType, const Fortran::parser::Variable &assignmentStmtVariable,
|
|
const Fortran::parser::Expr &assignmentStmtExpr,
|
|
[[maybe_unused]] const AtomicListT *leftHandClauseList,
|
|
[[maybe_unused]] const AtomicListT *rightHandClauseList, mlir::Location loc,
|
|
mlir::Operation *atomicCaptureOp = nullptr) {
|
|
// Generate `atomic.update` operation for atomic assignment statements
|
|
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
|
|
mlir::Location currentLocation = converter.getCurrentLocation();
|
|
|
|
// Create the omp.atomic.update or acc.atomic.update operation
|
|
//
|
|
// func.func @_QPsb() {
|
|
// %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"}
|
|
// %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"}
|
|
// %2 = fir.load %1 : !fir.ref<i32>
|
|
// omp.atomic.update %0 : !fir.ref<i32> {
|
|
// ^bb0(%arg0: i32):
|
|
// %3 = arith.addi %arg0, %2 : i32
|
|
// omp.yield(%3 : i32)
|
|
// }
|
|
// return
|
|
// }
|
|
|
|
auto getArgExpression =
|
|
[](std::list<parser::ActualArgSpec>::const_iterator it) {
|
|
const auto &arg{std::get<parser::ActualArg>((*it).t)};
|
|
const auto *parserExpr{
|
|
std::get_if<common::Indirection<parser::Expr>>(&arg.u)};
|
|
return parserExpr;
|
|
};
|
|
|
|
// Lower any non atomic sub-expression before the atomic operation, and
|
|
// map its lowered value to the semantic representation.
|
|
Fortran::lower::ExprToValueMap exprValueOverrides;
|
|
// Max and min intrinsics can have a list of Args. Hence we need a list
|
|
// of nonAtomicSubExprs to hoist. Currently, only the load is hoisted.
|
|
llvm::SmallVector<const Fortran::lower::SomeExpr *> nonAtomicSubExprs;
|
|
Fortran::common::visit(
|
|
Fortran::common::visitors{
|
|
[&](const common::Indirection<parser::FunctionReference> &funcRef)
|
|
-> void {
|
|
const auto &args{std::get<std::list<parser::ActualArgSpec>>(
|
|
funcRef.value().v.t)};
|
|
std::list<parser::ActualArgSpec>::const_iterator beginIt =
|
|
args.begin();
|
|
std::list<parser::ActualArgSpec>::const_iterator endIt = args.end();
|
|
const auto *exprFirst{getArgExpression(beginIt)};
|
|
if (exprFirst && exprFirst->value().source ==
|
|
assignmentStmtVariable.GetSource()) {
|
|
// Add everything except the first
|
|
beginIt++;
|
|
} else {
|
|
// Add everything except the last
|
|
endIt--;
|
|
}
|
|
std::list<parser::ActualArgSpec>::const_iterator it;
|
|
for (it = beginIt; it != endIt; it++) {
|
|
const common::Indirection<parser::Expr> *expr =
|
|
getArgExpression(it);
|
|
if (expr)
|
|
nonAtomicSubExprs.push_back(Fortran::semantics::GetExpr(*expr));
|
|
}
|
|
},
|
|
[&](const auto &op) -> void {
|
|
using T = std::decay_t<decltype(op)>;
|
|
if constexpr (std::is_base_of<
|
|
Fortran::parser::Expr::IntrinsicBinary,
|
|
T>::value) {
|
|
const auto &exprLeft{std::get<0>(op.t)};
|
|
const auto &exprRight{std::get<1>(op.t)};
|
|
if (exprLeft.value().source == assignmentStmtVariable.GetSource())
|
|
nonAtomicSubExprs.push_back(
|
|
Fortran::semantics::GetExpr(exprRight));
|
|
else
|
|
nonAtomicSubExprs.push_back(
|
|
Fortran::semantics::GetExpr(exprLeft));
|
|
}
|
|
},
|
|
},
|
|
assignmentStmtExpr.u);
|
|
StatementContext nonAtomicStmtCtx;
|
|
if (!nonAtomicSubExprs.empty()) {
|
|
// Generate non atomic part before all the atomic operations.
|
|
auto insertionPoint = firOpBuilder.saveInsertionPoint();
|
|
if (atomicCaptureOp)
|
|
firOpBuilder.setInsertionPoint(atomicCaptureOp);
|
|
mlir::Value nonAtomicVal;
|
|
for (auto *nonAtomicSubExpr : nonAtomicSubExprs) {
|
|
nonAtomicVal = fir::getBase(converter.genExprValue(
|
|
currentLocation, *nonAtomicSubExpr, nonAtomicStmtCtx));
|
|
exprValueOverrides.try_emplace(nonAtomicSubExpr, nonAtomicVal);
|
|
}
|
|
if (atomicCaptureOp)
|
|
firOpBuilder.restoreInsertionPoint(insertionPoint);
|
|
}
|
|
|
|
mlir::Operation *atomicUpdateOp = nullptr;
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// If no hint clause is specified, the effect is as if
|
|
// hint(omp_sync_hint_none) had been specified.
|
|
mlir::IntegerAttr hint = nullptr;
|
|
mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
|
|
if (leftHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList,
|
|
hint, memoryOrder);
|
|
if (rightHandClauseList)
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList,
|
|
hint, memoryOrder);
|
|
atomicUpdateOp = firOpBuilder.create<mlir::omp::AtomicUpdateOp>(
|
|
currentLocation, lhsAddr, hint, memoryOrder);
|
|
} else {
|
|
atomicUpdateOp = firOpBuilder.create<mlir::acc::AtomicUpdateOp>(
|
|
currentLocation, lhsAddr);
|
|
}
|
|
|
|
llvm::SmallVector<mlir::Type> varTys = {varType};
|
|
llvm::SmallVector<mlir::Location> locs = {currentLocation};
|
|
firOpBuilder.createBlock(&atomicUpdateOp->getRegion(0), {}, varTys, locs);
|
|
mlir::Value val =
|
|
fir::getBase(atomicUpdateOp->getRegion(0).front().getArgument(0));
|
|
|
|
exprValueOverrides.try_emplace(
|
|
Fortran::semantics::GetExpr(assignmentStmtVariable), val);
|
|
{
|
|
// statement context inside the atomic block.
|
|
converter.overrideExprValues(&exprValueOverrides);
|
|
Fortran::lower::StatementContext atomicStmtCtx;
|
|
mlir::Value rhsExpr = fir::getBase(converter.genExprValue(
|
|
*Fortran::semantics::GetExpr(assignmentStmtExpr), atomicStmtCtx));
|
|
mlir::Value convertResult =
|
|
firOpBuilder.createConvert(currentLocation, varType, rhsExpr);
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
firOpBuilder.create<mlir::omp::YieldOp>(currentLocation, convertResult);
|
|
} else {
|
|
firOpBuilder.create<mlir::acc::YieldOp>(currentLocation, convertResult);
|
|
}
|
|
converter.resetExprOverrides();
|
|
}
|
|
firOpBuilder.setInsertionPointAfter(atomicUpdateOp);
|
|
}
|
|
|
|
/// Processes an atomic construct with write clause.
|
|
template <typename AtomicT, typename AtomicListT>
|
|
void genOmpAccAtomicWrite(Fortran::lower::AbstractConverter &converter,
|
|
const AtomicT &atomicWrite, mlir::Location loc) {
|
|
const AtomicListT *rightHandClauseList = nullptr;
|
|
const AtomicListT *leftHandClauseList = nullptr;
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// Get the address of atomic read operands.
|
|
rightHandClauseList = &std::get<2>(atomicWrite.t);
|
|
leftHandClauseList = &std::get<0>(atomicWrite.t);
|
|
}
|
|
|
|
const Fortran::parser::AssignmentStmt &stmt =
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicWrite.t)
|
|
.statement;
|
|
const Fortran::evaluate::Assignment &assign = *stmt.typedAssignment->v;
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
// Get the value and address of atomic write operands.
|
|
mlir::Value rhsExpr =
|
|
fir::getBase(converter.genExprValue(assign.rhs, stmtCtx));
|
|
mlir::Value lhsAddr =
|
|
fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx));
|
|
genOmpAccAtomicWriteStatement(converter, lhsAddr, rhsExpr, leftHandClauseList,
|
|
rightHandClauseList, loc);
|
|
}
|
|
|
|
/// Processes an atomic construct with read clause.
|
|
template <typename AtomicT, typename AtomicListT>
|
|
void genOmpAccAtomicRead(Fortran::lower::AbstractConverter &converter,
|
|
const AtomicT &atomicRead, mlir::Location loc) {
|
|
const AtomicListT *rightHandClauseList = nullptr;
|
|
const AtomicListT *leftHandClauseList = nullptr;
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// Get the address of atomic read operands.
|
|
rightHandClauseList = &std::get<2>(atomicRead.t);
|
|
leftHandClauseList = &std::get<0>(atomicRead.t);
|
|
}
|
|
|
|
const auto &assignmentStmtExpr = std::get<Fortran::parser::Expr>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicRead.t)
|
|
.statement.t);
|
|
const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicRead.t)
|
|
.statement.t);
|
|
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
const Fortran::semantics::SomeExpr &fromExpr =
|
|
*Fortran::semantics::GetExpr(assignmentStmtExpr);
|
|
mlir::Type elementType = converter.genType(fromExpr);
|
|
mlir::Value fromAddress =
|
|
fir::getBase(converter.genExprAddr(fromExpr, stmtCtx));
|
|
mlir::Value toAddress = fir::getBase(converter.genExprAddr(
|
|
*Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
if (fromAddress.getType() != toAddress.getType())
|
|
fromAddress =
|
|
builder.create<fir::ConvertOp>(loc, toAddress.getType(), fromAddress);
|
|
genOmpAccAtomicCaptureStatement(converter, fromAddress, toAddress,
|
|
leftHandClauseList, rightHandClauseList,
|
|
elementType, loc);
|
|
}
|
|
|
|
/// Processes an atomic construct with update clause.
|
|
template <typename AtomicT, typename AtomicListT>
|
|
void genOmpAccAtomicUpdate(Fortran::lower::AbstractConverter &converter,
|
|
const AtomicT &atomicUpdate, mlir::Location loc) {
|
|
const AtomicListT *rightHandClauseList = nullptr;
|
|
const AtomicListT *leftHandClauseList = nullptr;
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
// Get the address of atomic read operands.
|
|
rightHandClauseList = &std::get<2>(atomicUpdate.t);
|
|
leftHandClauseList = &std::get<0>(atomicUpdate.t);
|
|
}
|
|
|
|
const auto &assignmentStmtExpr = std::get<Fortran::parser::Expr>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicUpdate.t)
|
|
.statement.t);
|
|
const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicUpdate.t)
|
|
.statement.t);
|
|
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
mlir::Value lhsAddr = fir::getBase(converter.genExprAddr(
|
|
*Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));
|
|
mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());
|
|
genOmpAccAtomicUpdateStatement<AtomicListT>(
|
|
converter, lhsAddr, varType, assignmentStmtVariable, assignmentStmtExpr,
|
|
leftHandClauseList, rightHandClauseList, loc);
|
|
}
|
|
|
|
/// Processes an atomic construct with no clause - which implies update clause.
|
|
template <typename AtomicT, typename AtomicListT>
|
|
void genOmpAtomic(Fortran::lower::AbstractConverter &converter,
|
|
const AtomicT &atomicConstruct, mlir::Location loc) {
|
|
const AtomicListT &atomicClauseList =
|
|
std::get<AtomicListT>(atomicConstruct.t);
|
|
const auto &assignmentStmtExpr = std::get<Fortran::parser::Expr>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicConstruct.t)
|
|
.statement.t);
|
|
const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
|
|
std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(
|
|
atomicConstruct.t)
|
|
.statement.t);
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
mlir::Value lhsAddr = fir::getBase(converter.genExprAddr(
|
|
*Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));
|
|
mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());
|
|
// If atomic-clause is not present on the construct, the behaviour is as if
|
|
// the update clause is specified (for both OpenMP and OpenACC).
|
|
genOmpAccAtomicUpdateStatement<AtomicListT>(
|
|
converter, lhsAddr, varType, assignmentStmtVariable, assignmentStmtExpr,
|
|
&atomicClauseList, nullptr, loc);
|
|
}
|
|
|
|
/// Processes an atomic construct with capture clause.
|
|
template <typename AtomicT, typename AtomicListT>
|
|
void genOmpAccAtomicCapture(Fortran::lower::AbstractConverter &converter,
|
|
const AtomicT &atomicCapture, mlir::Location loc) {
|
|
fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
|
|
|
|
const Fortran::parser::AssignmentStmt &stmt1 =
|
|
std::get<typename AtomicT::Stmt1>(atomicCapture.t).v.statement;
|
|
const Fortran::evaluate::Assignment &assign1 = *stmt1.typedAssignment->v;
|
|
const auto &stmt1Var{std::get<Fortran::parser::Variable>(stmt1.t)};
|
|
const auto &stmt1Expr{std::get<Fortran::parser::Expr>(stmt1.t)};
|
|
const Fortran::parser::AssignmentStmt &stmt2 =
|
|
std::get<typename AtomicT::Stmt2>(atomicCapture.t).v.statement;
|
|
const Fortran::evaluate::Assignment &assign2 = *stmt2.typedAssignment->v;
|
|
const auto &stmt2Var{std::get<Fortran::parser::Variable>(stmt2.t)};
|
|
const auto &stmt2Expr{std::get<Fortran::parser::Expr>(stmt2.t)};
|
|
|
|
// Pre-evaluate expressions to be used in the various operations inside
|
|
// `atomic.capture` since it is not desirable to have anything other than
|
|
// a `atomic.read`, `atomic.write`, or `atomic.update` operation
|
|
// inside `atomic.capture`
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
mlir::Value stmt1LHSArg, stmt1RHSArg, stmt2LHSArg, stmt2RHSArg;
|
|
mlir::Type elementType;
|
|
// LHS evaluations are common to all combinations of `atomic.capture`
|
|
stmt1LHSArg = fir::getBase(converter.genExprAddr(assign1.lhs, stmtCtx));
|
|
stmt2LHSArg = fir::getBase(converter.genExprAddr(assign2.lhs, stmtCtx));
|
|
|
|
// Operation specific RHS evaluations
|
|
if (checkForSingleVariableOnRHS(stmt1)) {
|
|
// Atomic capture construct is of the form [capture-stmt, update-stmt] or
|
|
// of the form [capture-stmt, write-stmt]
|
|
stmt1RHSArg = fir::getBase(converter.genExprAddr(assign1.rhs, stmtCtx));
|
|
stmt2RHSArg = fir::getBase(converter.genExprValue(assign2.rhs, stmtCtx));
|
|
} else {
|
|
// Atomic capture construct is of the form [update-stmt, capture-stmt]
|
|
stmt1RHSArg = fir::getBase(converter.genExprValue(assign1.rhs, stmtCtx));
|
|
stmt2RHSArg = fir::getBase(converter.genExprAddr(assign2.lhs, stmtCtx));
|
|
}
|
|
// Type information used in generation of `atomic.update` operation
|
|
mlir::Type stmt1VarType =
|
|
fir::getBase(converter.genExprValue(assign1.lhs, stmtCtx)).getType();
|
|
mlir::Type stmt2VarType =
|
|
fir::getBase(converter.genExprValue(assign2.lhs, stmtCtx)).getType();
|
|
|
|
mlir::Operation *atomicCaptureOp = nullptr;
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
mlir::IntegerAttr hint = nullptr;
|
|
mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
|
|
const AtomicListT &rightHandClauseList = std::get<2>(atomicCapture.t);
|
|
const AtomicListT &leftHandClauseList = std::get<0>(atomicCapture.t);
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
|
|
memoryOrder);
|
|
genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
|
|
memoryOrder);
|
|
atomicCaptureOp =
|
|
firOpBuilder.create<mlir::omp::AtomicCaptureOp>(loc, hint, memoryOrder);
|
|
} else {
|
|
atomicCaptureOp = firOpBuilder.create<mlir::acc::AtomicCaptureOp>(loc);
|
|
}
|
|
|
|
firOpBuilder.createBlock(&(atomicCaptureOp->getRegion(0)));
|
|
mlir::Block &block = atomicCaptureOp->getRegion(0).back();
|
|
firOpBuilder.setInsertionPointToStart(&block);
|
|
if (checkForSingleVariableOnRHS(stmt1)) {
|
|
if (checkForSymbolMatch(stmt2)) {
|
|
// Atomic capture construct is of the form [capture-stmt, update-stmt]
|
|
const Fortran::semantics::SomeExpr &fromExpr =
|
|
*Fortran::semantics::GetExpr(stmt1Expr);
|
|
elementType = converter.genType(fromExpr);
|
|
genOmpAccAtomicCaptureStatement<AtomicListT>(
|
|
converter, stmt1RHSArg, stmt1LHSArg,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, elementType, loc);
|
|
genOmpAccAtomicUpdateStatement<AtomicListT>(
|
|
converter, stmt1RHSArg, stmt2VarType, stmt2Var, stmt2Expr,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, loc, atomicCaptureOp);
|
|
} else {
|
|
// Atomic capture construct is of the form [capture-stmt, write-stmt]
|
|
const Fortran::semantics::SomeExpr &fromExpr =
|
|
*Fortran::semantics::GetExpr(stmt1Expr);
|
|
elementType = converter.genType(fromExpr);
|
|
genOmpAccAtomicCaptureStatement<AtomicListT>(
|
|
converter, stmt1RHSArg, stmt1LHSArg,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, elementType, loc);
|
|
genOmpAccAtomicWriteStatement<AtomicListT>(
|
|
converter, stmt1RHSArg, stmt2RHSArg,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, loc);
|
|
}
|
|
} else {
|
|
// Atomic capture construct is of the form [update-stmt, capture-stmt]
|
|
firOpBuilder.setInsertionPointToEnd(&block);
|
|
const Fortran::semantics::SomeExpr &fromExpr =
|
|
*Fortran::semantics::GetExpr(stmt2Expr);
|
|
elementType = converter.genType(fromExpr);
|
|
genOmpAccAtomicCaptureStatement<AtomicListT>(
|
|
converter, stmt1LHSArg, stmt2LHSArg,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, elementType, loc);
|
|
firOpBuilder.setInsertionPointToStart(&block);
|
|
genOmpAccAtomicUpdateStatement<AtomicListT>(
|
|
converter, stmt1LHSArg, stmt1VarType, stmt1Var, stmt1Expr,
|
|
/*leftHandClauseList=*/nullptr,
|
|
/*rightHandClauseList=*/nullptr, loc, atomicCaptureOp);
|
|
}
|
|
firOpBuilder.setInsertionPointToEnd(&block);
|
|
if constexpr (std::is_same<AtomicListT,
|
|
Fortran::parser::OmpAtomicClauseList>()) {
|
|
firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
|
|
} else {
|
|
firOpBuilder.create<mlir::acc::TerminatorOp>(loc);
|
|
}
|
|
firOpBuilder.setInsertionPointToStart(&block);
|
|
}
|
|
|
|
/// Create empty blocks for the current region.
|
|
/// These blocks replace blocks parented to an enclosing region.
|
|
template <typename... TerminatorOps>
|
|
void createEmptyRegionBlocks(
|
|
fir::FirOpBuilder &builder,
|
|
std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
|
|
mlir::Region *region = &builder.getRegion();
|
|
for (Fortran::lower::pft::Evaluation &eval : evaluationList) {
|
|
if (eval.block) {
|
|
if (eval.block->empty()) {
|
|
eval.block->erase();
|
|
eval.block = builder.createBlock(region);
|
|
} else {
|
|
[[maybe_unused]] mlir::Operation &terminatorOp = eval.block->back();
|
|
assert(mlir::isa<TerminatorOps...>(terminatorOp) &&
|
|
"expected terminator op");
|
|
}
|
|
}
|
|
if (!eval.isDirective() && eval.hasNestedEvaluations())
|
|
createEmptyRegionBlocks<TerminatorOps...>(builder,
|
|
eval.getNestedEvaluations());
|
|
}
|
|
}
|
|
|
|
inline AddrAndBoundsInfo
|
|
getDataOperandBaseAddr(Fortran::lower::AbstractConverter &converter,
|
|
fir::FirOpBuilder &builder,
|
|
Fortran::lower::SymbolRef sym, mlir::Location loc) {
|
|
mlir::Value symAddr = converter.getSymbolAddress(sym);
|
|
// TODO: Might need revisiting to handle for non-shared clauses
|
|
if (!symAddr) {
|
|
if (const auto *details =
|
|
sym->detailsIf<Fortran::semantics::HostAssocDetails>())
|
|
symAddr = converter.getSymbolAddress(details->symbol());
|
|
}
|
|
|
|
if (!symAddr)
|
|
llvm::report_fatal_error("could not retrieve symbol address");
|
|
|
|
if (auto boxTy =
|
|
fir::unwrapRefType(symAddr.getType()).dyn_cast<fir::BaseBoxType>()) {
|
|
if (boxTy.getEleTy().isa<fir::RecordType>())
|
|
TODO(loc, "derived type");
|
|
|
|
// Load the box when baseAddr is a `fir.ref<fir.box<T>>` or a
|
|
// `fir.ref<fir.class<T>>` type.
|
|
if (symAddr.getType().isa<fir::ReferenceType>()) {
|
|
if (Fortran::semantics::IsOptional(sym)) {
|
|
mlir::Value isPresent =
|
|
builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), symAddr);
|
|
mlir::Value addr =
|
|
builder.genIfOp(loc, {boxTy}, isPresent, /*withElseRegion=*/true)
|
|
.genThen([&]() {
|
|
mlir::Value load = builder.create<fir::LoadOp>(loc, symAddr);
|
|
builder.create<fir::ResultOp>(loc, mlir::ValueRange{load});
|
|
})
|
|
.genElse([&] {
|
|
mlir::Value absent =
|
|
builder.create<fir::AbsentOp>(loc, boxTy);
|
|
builder.create<fir::ResultOp>(loc, mlir::ValueRange{absent});
|
|
})
|
|
.getResults()[0];
|
|
return AddrAndBoundsInfo(addr, isPresent);
|
|
}
|
|
mlir::Value addr = builder.create<fir::LoadOp>(loc, symAddr);
|
|
return AddrAndBoundsInfo(addr);
|
|
;
|
|
}
|
|
}
|
|
return AddrAndBoundsInfo(symAddr);
|
|
}
|
|
|
|
template <typename BoundsOp, typename BoundsType>
|
|
llvm::SmallVector<mlir::Value>
|
|
gatherBoundsOrBoundValues(fir::FirOpBuilder &builder, mlir::Location loc,
|
|
fir::ExtendedValue dataExv, mlir::Value box,
|
|
bool collectValuesOnly = false) {
|
|
llvm::SmallVector<mlir::Value> values;
|
|
mlir::Value byteStride;
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Type boundTy = builder.getType<BoundsType>();
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
for (unsigned dim = 0; dim < dataExv.rank(); ++dim) {
|
|
mlir::Value d = builder.createIntegerConstant(loc, idxTy, dim);
|
|
mlir::Value baseLb =
|
|
fir::factory::readLowerBound(builder, loc, dataExv, dim, one);
|
|
auto dimInfo =
|
|
builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, d);
|
|
mlir::Value lb = builder.createIntegerConstant(loc, idxTy, 0);
|
|
mlir::Value ub =
|
|
builder.create<mlir::arith::SubIOp>(loc, dimInfo.getExtent(), one);
|
|
if (dim == 0) // First stride is the element size.
|
|
byteStride = dimInfo.getByteStride();
|
|
if (collectValuesOnly) {
|
|
values.push_back(lb);
|
|
values.push_back(ub);
|
|
values.push_back(dimInfo.getExtent());
|
|
values.push_back(byteStride);
|
|
values.push_back(baseLb);
|
|
} else {
|
|
mlir::Value bound = builder.create<BoundsOp>(
|
|
loc, boundTy, lb, ub, dimInfo.getExtent(), byteStride, true, baseLb);
|
|
values.push_back(bound);
|
|
}
|
|
// Compute the stride for the next dimension.
|
|
byteStride = builder.create<mlir::arith::MulIOp>(loc, byteStride,
|
|
dimInfo.getExtent());
|
|
}
|
|
return values;
|
|
}
|
|
|
|
/// Generate the bounds operation from the descriptor information.
|
|
template <typename BoundsOp, typename BoundsType>
|
|
llvm::SmallVector<mlir::Value>
|
|
genBoundsOpsFromBox(fir::FirOpBuilder &builder, mlir::Location loc,
|
|
Fortran::lower::AbstractConverter &converter,
|
|
fir::ExtendedValue dataExv,
|
|
Fortran::lower::AddrAndBoundsInfo &info) {
|
|
llvm::SmallVector<mlir::Value> bounds;
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Type boundTy = builder.getType<BoundsType>();
|
|
|
|
assert(info.addr.getType().isa<fir::BaseBoxType>() &&
|
|
"expect fir.box or fir.class");
|
|
|
|
if (info.isPresent) {
|
|
llvm::SmallVector<mlir::Type> resTypes;
|
|
constexpr unsigned nbValuesPerBound = 5;
|
|
for (unsigned dim = 0; dim < dataExv.rank() * nbValuesPerBound; ++dim)
|
|
resTypes.push_back(idxTy);
|
|
|
|
mlir::Operation::result_range ifRes =
|
|
builder.genIfOp(loc, resTypes, info.isPresent, /*withElseRegion=*/true)
|
|
.genThen([&]() {
|
|
llvm::SmallVector<mlir::Value> boundValues =
|
|
gatherBoundsOrBoundValues<BoundsOp, BoundsType>(
|
|
builder, loc, dataExv, info.addr,
|
|
/*collectValuesOnly=*/true);
|
|
builder.create<fir::ResultOp>(loc, boundValues);
|
|
})
|
|
.genElse([&] {
|
|
// Box is not present. Populate bound values with default values.
|
|
llvm::SmallVector<mlir::Value> boundValues;
|
|
mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
|
|
mlir::Value mOne = builder.createIntegerConstant(loc, idxTy, -1);
|
|
for (unsigned dim = 0; dim < dataExv.rank(); ++dim) {
|
|
boundValues.push_back(zero); // lb
|
|
boundValues.push_back(mOne); // ub
|
|
boundValues.push_back(zero); // extent
|
|
boundValues.push_back(zero); // byteStride
|
|
boundValues.push_back(zero); // baseLb
|
|
}
|
|
builder.create<fir::ResultOp>(loc, boundValues);
|
|
})
|
|
.getResults();
|
|
// Create the bound operations outside the if-then-else with the if op
|
|
// results.
|
|
for (unsigned i = 0; i < ifRes.size(); i += nbValuesPerBound) {
|
|
mlir::Value bound = builder.create<BoundsOp>(
|
|
loc, boundTy, ifRes[i], ifRes[i + 1], ifRes[i + 2], ifRes[i + 3],
|
|
true, ifRes[i + 4]);
|
|
bounds.push_back(bound);
|
|
}
|
|
} else {
|
|
bounds = gatherBoundsOrBoundValues<BoundsOp, BoundsType>(
|
|
builder, loc, dataExv, info.addr);
|
|
}
|
|
return bounds;
|
|
}
|
|
|
|
/// Generate bounds operation for base array without any subscripts
|
|
/// provided.
|
|
template <typename BoundsOp, typename BoundsType>
|
|
llvm::SmallVector<mlir::Value>
|
|
genBaseBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
|
|
Fortran::lower::AbstractConverter &converter,
|
|
fir::ExtendedValue dataExv) {
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Type boundTy = builder.getType<BoundsType>();
|
|
llvm::SmallVector<mlir::Value> bounds;
|
|
|
|
if (dataExv.rank() == 0)
|
|
return bounds;
|
|
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
for (std::size_t dim = 0; dim < dataExv.rank(); ++dim) {
|
|
mlir::Value baseLb =
|
|
fir::factory::readLowerBound(builder, loc, dataExv, dim, one);
|
|
mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
|
|
mlir::Value ub;
|
|
mlir::Value lb = zero;
|
|
mlir::Value ext = fir::factory::readExtent(builder, loc, dataExv, dim);
|
|
if (mlir::isa<fir::UndefOp>(ext.getDefiningOp())) {
|
|
ext = zero;
|
|
ub = lb;
|
|
} else {
|
|
// ub = extent - 1
|
|
ub = builder.create<mlir::arith::SubIOp>(loc, ext, one);
|
|
}
|
|
|
|
mlir::Value bound =
|
|
builder.create<BoundsOp>(loc, boundTy, lb, ub, ext, one, false, baseLb);
|
|
bounds.push_back(bound);
|
|
}
|
|
return bounds;
|
|
}
|
|
|
|
/// Generate bounds operations for an array section when subscripts are
|
|
/// provided.
|
|
template <typename BoundsOp, typename BoundsType>
|
|
llvm::SmallVector<mlir::Value>
|
|
genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
|
|
Fortran::lower::AbstractConverter &converter,
|
|
Fortran::lower::StatementContext &stmtCtx,
|
|
const std::list<Fortran::parser::SectionSubscript> &subscripts,
|
|
std::stringstream &asFortran, fir::ExtendedValue &dataExv,
|
|
mlir::Value baseAddr, bool treatIndexAsSection = false) {
|
|
int dimension = 0;
|
|
mlir::Type idxTy = builder.getIndexType();
|
|
mlir::Type boundTy = builder.getType<BoundsType>();
|
|
llvm::SmallVector<mlir::Value> bounds;
|
|
|
|
mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
|
|
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
|
for (const auto &subscript : subscripts) {
|
|
const auto *triplet{
|
|
std::get_if<Fortran::parser::SubscriptTriplet>(&subscript.u)};
|
|
if (triplet || treatIndexAsSection) {
|
|
if (dimension != 0)
|
|
asFortran << ',';
|
|
mlir::Value lbound, ubound, extent;
|
|
std::optional<std::int64_t> lval, uval;
|
|
mlir::Value baseLb =
|
|
fir::factory::readLowerBound(builder, loc, dataExv, dimension, one);
|
|
bool defaultLb = baseLb == one;
|
|
mlir::Value stride = one;
|
|
bool strideInBytes = false;
|
|
|
|
if (fir::unwrapRefType(baseAddr.getType()).isa<fir::BaseBoxType>()) {
|
|
mlir::Value d = builder.createIntegerConstant(loc, idxTy, dimension);
|
|
auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
|
|
baseAddr, d);
|
|
stride = dimInfo.getByteStride();
|
|
strideInBytes = true;
|
|
}
|
|
|
|
const Fortran::lower::SomeExpr *lower{nullptr};
|
|
if (triplet) {
|
|
if (const auto &tripletLb{std::get<0>(triplet->t)})
|
|
lower = Fortran::semantics::GetExpr(*tripletLb);
|
|
} else {
|
|
const auto &index{std::get<Fortran::parser::IntExpr>(subscript.u)};
|
|
lower = Fortran::semantics::GetExpr(index);
|
|
if (lower->Rank() > 0) {
|
|
mlir::emitError(
|
|
loc, "vector subscript cannot be used for an array section");
|
|
break;
|
|
}
|
|
}
|
|
if (lower) {
|
|
lval = Fortran::evaluate::ToInt64(*lower);
|
|
if (lval) {
|
|
if (defaultLb) {
|
|
lbound = builder.createIntegerConstant(loc, idxTy, *lval - 1);
|
|
} else {
|
|
mlir::Value lb = builder.createIntegerConstant(loc, idxTy, *lval);
|
|
lbound = builder.create<mlir::arith::SubIOp>(loc, lb, baseLb);
|
|
}
|
|
asFortran << *lval;
|
|
} else {
|
|
mlir::Value lb =
|
|
fir::getBase(converter.genExprValue(loc, *lower, stmtCtx));
|
|
lb = builder.createConvert(loc, baseLb.getType(), lb);
|
|
lbound = builder.create<mlir::arith::SubIOp>(loc, lb, baseLb);
|
|
asFortran << lower->AsFortran();
|
|
}
|
|
} else {
|
|
// If the lower bound is not specified, then the section
|
|
// starts from offset 0 of the dimension.
|
|
// Note that the lowerbound in the BoundsOp is always 0-based.
|
|
lbound = zero;
|
|
}
|
|
|
|
if (!triplet) {
|
|
// If it is a scalar subscript, then the upper bound
|
|
// is equal to the lower bound, and the extent is one.
|
|
ubound = lbound;
|
|
extent = one;
|
|
} else {
|
|
asFortran << ':';
|
|
const auto &upper{std::get<1>(triplet->t)};
|
|
|
|
if (upper) {
|
|
uval = Fortran::semantics::GetIntValue(upper);
|
|
if (uval) {
|
|
if (defaultLb) {
|
|
ubound = builder.createIntegerConstant(loc, idxTy, *uval - 1);
|
|
} else {
|
|
mlir::Value ub = builder.createIntegerConstant(loc, idxTy, *uval);
|
|
ubound = builder.create<mlir::arith::SubIOp>(loc, ub, baseLb);
|
|
}
|
|
asFortran << *uval;
|
|
} else {
|
|
const Fortran::lower::SomeExpr *uexpr =
|
|
Fortran::semantics::GetExpr(*upper);
|
|
mlir::Value ub =
|
|
fir::getBase(converter.genExprValue(loc, *uexpr, stmtCtx));
|
|
ub = builder.createConvert(loc, baseLb.getType(), ub);
|
|
ubound = builder.create<mlir::arith::SubIOp>(loc, ub, baseLb);
|
|
asFortran << uexpr->AsFortran();
|
|
}
|
|
}
|
|
if (lower && upper) {
|
|
if (lval && uval && *uval < *lval) {
|
|
mlir::emitError(loc, "zero sized array section");
|
|
break;
|
|
} else if (std::get<2>(triplet->t)) {
|
|
const auto &strideExpr{std::get<2>(triplet->t)};
|
|
if (strideExpr) {
|
|
mlir::emitError(loc, "stride cannot be specified on "
|
|
"an array section");
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
extent = fir::factory::readExtent(builder, loc, dataExv, dimension);
|
|
if (mlir::isa<fir::UndefOp>(extent.getDefiningOp())) {
|
|
extent = zero;
|
|
if (ubound && lbound) {
|
|
mlir::Value diff =
|
|
builder.create<mlir::arith::SubIOp>(loc, ubound, lbound);
|
|
extent = builder.create<mlir::arith::AddIOp>(loc, diff, one);
|
|
}
|
|
if (!ubound)
|
|
ubound = lbound;
|
|
}
|
|
|
|
if (!ubound) {
|
|
// ub = extent - 1
|
|
ubound = builder.create<mlir::arith::SubIOp>(loc, extent, one);
|
|
}
|
|
}
|
|
mlir::Value bound = builder.create<BoundsOp>(
|
|
loc, boundTy, lbound, ubound, extent, stride, strideInBytes, baseLb);
|
|
bounds.push_back(bound);
|
|
++dimension;
|
|
}
|
|
}
|
|
return bounds;
|
|
}
|
|
|
|
template <typename ObjectType, typename BoundsOp, typename BoundsType>
|
|
AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
|
|
Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &builder,
|
|
Fortran::semantics::SemanticsContext &semanticsContext,
|
|
Fortran::lower::StatementContext &stmtCtx, const ObjectType &object,
|
|
mlir::Location operandLocation, std::stringstream &asFortran,
|
|
llvm::SmallVector<mlir::Value> &bounds, bool treatIndexAsSection = false) {
|
|
AddrAndBoundsInfo info;
|
|
std::visit(
|
|
Fortran::common::visitors{
|
|
[&](const Fortran::parser::Designator &designator) {
|
|
if (auto expr{Fortran::semantics::AnalyzeExpr(semanticsContext,
|
|
designator)}) {
|
|
if (((*expr).Rank() > 0 || treatIndexAsSection) &&
|
|
Fortran::parser::Unwrap<Fortran::parser::ArrayElement>(
|
|
designator)) {
|
|
const auto *arrayElement =
|
|
Fortran::parser::Unwrap<Fortran::parser::ArrayElement>(
|
|
designator);
|
|
const auto *dataRef =
|
|
std::get_if<Fortran::parser::DataRef>(&designator.u);
|
|
fir::ExtendedValue dataExv;
|
|
if (Fortran::parser::Unwrap<
|
|
Fortran::parser::StructureComponent>(
|
|
arrayElement->base)) {
|
|
auto exprBase = Fortran::semantics::AnalyzeExpr(
|
|
semanticsContext, arrayElement->base);
|
|
dataExv = converter.genExprAddr(operandLocation, *exprBase,
|
|
stmtCtx);
|
|
info.addr = fir::getBase(dataExv);
|
|
asFortran << (*exprBase).AsFortran();
|
|
} else {
|
|
const Fortran::parser::Name &name =
|
|
Fortran::parser::GetLastName(*dataRef);
|
|
info = getDataOperandBaseAddr(converter, builder,
|
|
*name.symbol, operandLocation);
|
|
dataExv = converter.getSymbolExtendedValue(*name.symbol);
|
|
asFortran << name.ToString();
|
|
}
|
|
|
|
if (!arrayElement->subscripts.empty()) {
|
|
asFortran << '(';
|
|
bounds = genBoundsOps<BoundsOp, BoundsType>(
|
|
builder, operandLocation, converter, stmtCtx,
|
|
arrayElement->subscripts, asFortran, dataExv, info.addr,
|
|
treatIndexAsSection);
|
|
}
|
|
asFortran << ')';
|
|
} else if (auto structComp = Fortran::parser::Unwrap<
|
|
Fortran::parser::StructureComponent>(designator)) {
|
|
fir::ExtendedValue compExv =
|
|
converter.genExprAddr(operandLocation, *expr, stmtCtx);
|
|
info.addr = fir::getBase(compExv);
|
|
if (fir::unwrapRefType(info.addr.getType())
|
|
.isa<fir::SequenceType>())
|
|
bounds = genBaseBoundsOps<BoundsOp, BoundsType>(
|
|
builder, operandLocation, converter, compExv);
|
|
asFortran << (*expr).AsFortran();
|
|
|
|
bool isOptional = Fortran::semantics::IsOptional(
|
|
*Fortran::parser::GetLastName(*structComp).symbol);
|
|
if (isOptional)
|
|
info.isPresent = builder.create<fir::IsPresentOp>(
|
|
operandLocation, builder.getI1Type(), info.addr);
|
|
|
|
if (auto loadOp = mlir::dyn_cast_or_null<fir::LoadOp>(
|
|
info.addr.getDefiningOp())) {
|
|
if (fir::isAllocatableType(loadOp.getType()) ||
|
|
fir::isPointerType(loadOp.getType()))
|
|
info.addr = builder.create<fir::BoxAddrOp>(operandLocation,
|
|
info.addr);
|
|
}
|
|
|
|
// If the component is an allocatable or pointer the result of
|
|
// genExprAddr will be the result of a fir.box_addr operation or
|
|
// a fir.box_addr has been inserted just before.
|
|
// Retrieve the box so we handle it like other descriptor.
|
|
if (auto boxAddrOp = mlir::dyn_cast_or_null<fir::BoxAddrOp>(
|
|
info.addr.getDefiningOp())) {
|
|
info.addr = boxAddrOp.getVal();
|
|
bounds = genBoundsOpsFromBox<BoundsOp, BoundsType>(
|
|
builder, operandLocation, converter, compExv, info);
|
|
}
|
|
} else {
|
|
if (Fortran::parser::Unwrap<Fortran::parser::ArrayElement>(
|
|
designator)) {
|
|
// Single array element.
|
|
const auto *arrayElement =
|
|
Fortran::parser::Unwrap<Fortran::parser::ArrayElement>(
|
|
designator);
|
|
(void)arrayElement;
|
|
fir::ExtendedValue compExv =
|
|
converter.genExprAddr(operandLocation, *expr, stmtCtx);
|
|
info.addr = fir::getBase(compExv);
|
|
asFortran << (*expr).AsFortran();
|
|
} else if (const auto *dataRef{
|
|
std::get_if<Fortran::parser::DataRef>(
|
|
&designator.u)}) {
|
|
// Scalar or full array.
|
|
const Fortran::parser::Name &name =
|
|
Fortran::parser::GetLastName(*dataRef);
|
|
fir::ExtendedValue dataExv =
|
|
converter.getSymbolExtendedValue(*name.symbol);
|
|
info = getDataOperandBaseAddr(converter, builder,
|
|
*name.symbol, operandLocation);
|
|
if (fir::unwrapRefType(info.addr.getType())
|
|
.isa<fir::BaseBoxType>()) {
|
|
bounds = genBoundsOpsFromBox<BoundsOp, BoundsType>(
|
|
builder, operandLocation, converter, dataExv, info);
|
|
}
|
|
if (fir::unwrapRefType(info.addr.getType())
|
|
.isa<fir::SequenceType>())
|
|
bounds = genBaseBoundsOps<BoundsOp, BoundsType>(
|
|
builder, operandLocation, converter, dataExv);
|
|
asFortran << name.ToString();
|
|
} else { // Unsupported
|
|
llvm::report_fatal_error(
|
|
"Unsupported type of OpenACC operand");
|
|
}
|
|
}
|
|
}
|
|
},
|
|
[&](const Fortran::parser::Name &name) {
|
|
info = getDataOperandBaseAddr(converter, builder, *name.symbol,
|
|
operandLocation);
|
|
asFortran << name.ToString();
|
|
}},
|
|
object.u);
|
|
return info;
|
|
}
|
|
|
|
} // namespace lower
|
|
} // namespace Fortran
|
|
|
|
#endif // FORTRAN_LOWER_DIRECTIVES_COMMON_H
|