[flang-commits] [flang] 7531c87 - [flang][hlfir] Enable allocate, deallocate, pointer assignment lowering
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Fri Jan 20 05:08:16 PST 2023
Author: Jean Perier
Date: 2023-01-20T14:06:30+01:00
New Revision: 7531c87183822cf8931496a757a09779e24aeac0
URL: https://github.com/llvm/llvm-project/commit/7531c87183822cf8931496a757a09779e24aeac0
DIFF: https://github.com/llvm/llvm-project/commit/7531c87183822cf8931496a757a09779e24aeac0.diff
LOG: [flang][hlfir] Enable allocate, deallocate, pointer assignment lowering
The previous patches allowed lowering allocatable/and pointer designator
expressions with HLFIR.
This patch updates the bridge genExprMutableBox to use HLFIR lowering
when HLFIR flag is set. For allocate and deallocate lowering that use
genExprMutableBox, no other change is needed.
For pointer assignments, the code doing the pointer assignments in the
bridge can be reused and is simply moved so that it can be shared, and
the "explicit context" special cases of the previous lowering are
by-passed.
The code doing pointer assignment revealed that convertExprToAddress
did not match the previous genExprAddr behavior (that actually
does not create temps for "x" where x is not contiguous).
Instead of trying to copy the old behavior that is a bit weird (was
dictated by the implementation rather than design). Update
convertExprToAddress to do something sensible and that works with
the current genExprAddr usages (if anything, it should saves bogus
array section temps).
Differential Revision: https://reviews.llvm.org/D142197
Added:
flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
Modified:
flang/include/flang/Lower/ConvertExprToHLFIR.h
flang/lib/Lower/Allocatable.cpp
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/ConvertExprToHLFIR.h b/flang/include/flang/Lower/ConvertExprToHLFIR.h
index 91f2ae56caa43..eea2b644801e4 100644
--- a/flang/include/flang/Lower/ConvertExprToHLFIR.h
+++ b/flang/include/flang/Lower/ConvertExprToHLFIR.h
@@ -59,9 +59,29 @@ fir::BoxValue convertToBox(mlir::Location loc,
hlfir::Entity entity,
Fortran::lower::StatementContext &);
-/// Lower an evaluate::Expr to fir::ExtendedValue raw address.
-/// Beware that this will create a temporary for non simply contiguous
-/// designator expressions.
+/// Lower an evaluate::Expr to fir::ExtendedValue address.
+/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, (pointer
+/// and allocatable are dereferenced).
+/// - If expression is not a variable, or is a designator with vector
+/// subscripts, a temporary is created to hold the expression value and
+/// is returned as:
+/// - a fir.class<T> if the expression is polymorphic.
+/// - otherwise, a fir.box<T> if it is a derived type with length
+/// parameters (not yet implemented).
+/// - otherwise, a fir.ref<T>
+/// - If the expression is a variable that is not a designator with
+/// vector subscripts, it is lowered without creating a temporary and
+/// is returned as:
+/// - a fir.class<T> if the variable is polymorphic.
+/// - otherwise, a fir.box<T> if it is a derived type with length
+/// parameters (not yet implemented), or if it is not a simply
+/// contiguous.
+/// - otherwise, a fir.ref<T>
+///
+/// Beware that this is
diff erent from the previous createSomeExtendedAddress
+/// that had a non-trivial behaviour and would create contiguous temporary for
+/// array sections `x(:, :)`, but not for `x` even if x is not simply
+/// contiguous.
fir::ExtendedValue convertExprToAddress(mlir::Location loc,
Fortran::lower::AbstractConverter &,
const Fortran::lower::SomeExpr &,
@@ -70,7 +90,6 @@ fir::ExtendedValue convertExprToAddress(mlir::Location loc,
fir::ExtendedValue convertToAddress(mlir::Location loc,
Fortran::lower::AbstractConverter &,
hlfir::Entity entity,
- bool isSimplyContiguous,
Fortran::lower::StatementContext &);
/// Lower an evaluate::Expr to a fir::ExtendedValue value.
@@ -83,6 +102,14 @@ fir::ExtendedValue convertToValue(mlir::Location loc,
Fortran::lower::AbstractConverter &,
hlfir::Entity entity,
Fortran::lower::StatementContext &);
+
+/// Lower an evaluate::Expr to a fir::MutableBoxValue value.
+/// This can only be called if the Expr is a POINTER or ALLOCATABLE,
+/// otherwise, this will crash.
+fir::MutableBoxValue
+convertExprToMutableBox(mlir::Location loc, Fortran::lower::AbstractConverter &,
+ const Fortran::lower::SomeExpr &,
+ Fortran::lower::SymMap &);
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 5e34ab101c865..50545b44877bb 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -935,7 +935,11 @@ void Fortran::lower::associateMutableBox(
fir::factory::disassociateMutableBox(builder, loc, box);
return;
}
-
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+ fir::ExtendedValue rhs = converter.genExprAddr(loc, source, stmtCtx);
+ fir::factory::associateMutableBox(builder, loc, box, rhs, lbounds);
+ return;
+ }
// The right hand side is not be evaluated into a temp. Array sections can
// typically be represented as a value of type `!fir.box`. However, an
// expression that uses vector subscripts cannot be emboxed. In that case,
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 783f77c10659d..c8971ea5036dc 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -429,7 +429,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void copySymbolBinding(Fortran::lower::SymbolRef src,
Fortran::lower::SymbolRef target) override final {
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ if (lowerToHighLevelFIR()) {
auto srcDef = localSymbols.lookupVariableDefinition(src);
assert(srcDef && "source binding does not exists");
localSymbols.addVariableDefinition(target, *srcDef);
@@ -479,7 +479,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::StatementContext &context,
mlir::Location *locPtr = nullptr) override final {
mlir::Location loc = locPtr ? *locPtr : toLocation();
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+ if (lowerToHighLevelFIR())
return Fortran::lower::convertExprToAddress(loc, *this, expr,
localSymbols, context);
return Fortran::lower::createSomeExtendedAddress(loc, *this, expr,
@@ -491,7 +491,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::StatementContext &context,
mlir::Location *locPtr = nullptr) override final {
mlir::Location loc = locPtr ? *locPtr : toLocation();
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+ if (lowerToHighLevelFIR())
return Fortran::lower::convertExprToValue(loc, *this, expr, localSymbols,
context);
return Fortran::lower::createSomeExtendedExpression(loc, *this, expr,
@@ -501,7 +501,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::ExtendedValue
genExprBox(mlir::Location loc, const Fortran::lower::SomeExpr &expr,
Fortran::lower::StatementContext &stmtCtx) override final {
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+ if (lowerToHighLevelFIR())
return Fortran::lower::convertExprToBox(loc, *this, expr, localSymbols,
stmtCtx);
return Fortran::lower::createBoxValue(loc, *this, expr, localSymbols,
@@ -769,7 +769,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// Find the symbol in the local map or return null.
Fortran::lower::SymbolBox
lookupSymbol(const Fortran::semantics::Symbol &sym) {
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ if (lowerToHighLevelFIR()) {
if (std::optional<fir::FortranVariableOpInterface> var =
localSymbols.lookupVariableDefinition(sym)) {
auto exv =
@@ -1044,7 +1044,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
setCurrentPosition(stmt.v.source);
assert(stmt.typedCall && "Call was not analyzed");
mlir::Value res{};
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ if (lowerToHighLevelFIR()) {
std::optional<mlir::Type> resultType;
if (stmt.typedCall->hasAlternateReturns())
resultType = builder->getIndexType();
@@ -2571,14 +2571,138 @@ class FirConverter : public Fortran::lower::AbstractConverter {
inline fir::MutableBoxValue
genExprMutableBox(mlir::Location loc,
const Fortran::lower::SomeExpr &expr) override final {
+ if (lowerToHighLevelFIR())
+ return Fortran::lower::convertExprToMutableBox(loc, *this, expr,
+ localSymbols);
return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
}
+ // Generate pointer assignment with possibly empty bounds-spec. R1035: a
+ // bounds-spec is a lower bound value.
+ void genPointerAssignment(
+ mlir::Location loc, const Fortran::evaluate::Assignment &assign,
+ const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
+ Fortran::lower::StatementContext stmtCtx;
+ if (Fortran::evaluate::IsProcedure(assign.rhs))
+ TODO(loc, "procedure pointer assignment");
+
+ std::optional<Fortran::evaluate::DynamicType> lhsType =
+ assign.lhs.GetType();
+ // Delegate pointer association to unlimited polymorphic pointer
+ // to the runtime. element size, type code, attribute and of
+ // course base_addr might need to be updated.
+ if (lhsType && lhsType->IsPolymorphic()) {
+ if (!lowerToHighLevelFIR() && explicitIterationSpace())
+ TODO(loc, "polymorphic pointer assignment in FORALL");
+ mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+ mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
+ Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
+ return;
+ }
+
+ llvm::SmallVector<mlir::Value> lbounds;
+ for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
+ lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
+ if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+ // Pointer assignment in FORALL context. Copy the rhs box value
+ // into the lhs box variable.
+ genArrayAssignment(assign, stmtCtx, lbounds);
+ return;
+ }
+ fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+ Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs, lbounds,
+ stmtCtx);
+ }
+ // Pointer assignment with bounds-remapping. R1036: a bounds-remapping is a
+ // pair, lower bound and upper bound.
+ void genPointerAssignment(
+ mlir::Location loc, const Fortran::evaluate::Assignment &assign,
+ const Fortran::evaluate::Assignment::BoundsRemapping &boundExprs) {
+ Fortran::lower::StatementContext stmtCtx;
+ llvm::SmallVector<mlir::Value> lbounds;
+ llvm::SmallVector<mlir::Value> ubounds;
+ for (const std::pair<Fortran::evaluate::ExtentExpr,
+ Fortran::evaluate::ExtentExpr> &pair : boundExprs) {
+ const Fortran::evaluate::ExtentExpr &lbExpr = pair.first;
+ const Fortran::evaluate::ExtentExpr &ubExpr = pair.second;
+ lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
+ ubounds.push_back(fir::getBase(genExprValue(toEvExpr(ubExpr), stmtCtx)));
+ }
+
+ std::optional<Fortran::evaluate::DynamicType> lhsType =
+ assign.lhs.GetType();
+ std::optional<Fortran::evaluate::DynamicType> rhsType =
+ assign.rhs.GetType();
+ // Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
+ if ((lhsType && lhsType->IsPolymorphic()) ||
+ (rhsType && rhsType->IsPolymorphic())) {
+ if (!lowerToHighLevelFIR() && explicitIterationSpace())
+ TODO(loc, "polymorphic pointer assignment in FORALL");
+
+ mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+ mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
+
+ // Create the newRank x 2 array with the bounds to be passed to
+ // the runtime as a descriptor.
+ assert(lbounds.size() && ubounds.size());
+ mlir::Type indexTy = builder->getIndexType();
+ mlir::Type boundArrayTy = fir::SequenceType::get(
+ {static_cast<int64_t>(lbounds.size()) * 2}, builder->getI64Type());
+ mlir::Value boundArray =
+ builder->create<fir::AllocaOp>(loc, boundArrayTy);
+ mlir::Value array = builder->create<fir::UndefOp>(loc, boundArrayTy);
+ for (unsigned i = 0; i < lbounds.size(); ++i) {
+ array = builder->create<fir::InsertValueOp>(
+ loc, boundArrayTy, array, lbounds[i],
+ builder->getArrayAttr({builder->getIntegerAttr(
+ builder->getIndexType(), static_cast<int>(i * 2))}));
+ array = builder->create<fir::InsertValueOp>(
+ loc, boundArrayTy, array, ubounds[i],
+ builder->getArrayAttr({builder->getIntegerAttr(
+ builder->getIndexType(), static_cast<int>(i * 2 + 1))}));
+ }
+ builder->create<fir::StoreOp>(loc, array, boundArray);
+ mlir::Type boxTy = fir::BoxType::get(boundArrayTy);
+ mlir::Value ext =
+ builder->createIntegerConstant(loc, indexTy, lbounds.size() * 2);
+ mlir::Value shapeOp = builder->genShape(loc, {ext});
+ mlir::Value boundsDesc =
+ builder->create<fir::EmboxOp>(loc, boxTy, boundArray, shapeOp);
+ Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
+ boundsDesc);
+ return;
+ }
+ if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+ // Pointer assignment in FORALL context. Copy the rhs box value
+ // into the lhs box variable.
+ genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
+ return;
+ }
+ fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ assign.rhs)) {
+ fir::factory::disassociateMutableBox(*builder, loc, lhs);
+ return;
+ }
+ // Do not generate a temp in case rhs is an array section.
+ fir::ExtendedValue rhs =
+ Fortran::lower::isArraySectionWithoutVectorSubscript(assign.rhs)
+ ? Fortran::lower::createSomeArrayBox(*this, assign.rhs,
+ localSymbols, stmtCtx)
+ : genExprAddr(assign.rhs, stmtCtx);
+ fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs, rhs, lbounds,
+ ubounds);
+ if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+ mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
+ if (!inners.empty())
+ builder->create<fir::ResultOp>(loc, inners);
+ }
+ }
+
/// Shared for both assignments and pointer assignments.
void genAssignment(const Fortran::evaluate::Assignment &assign) {
- Fortran::lower::StatementContext stmtCtx;
mlir::Location loc = toLocation();
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ if (lowerToHighLevelFIR()) {
if (explicitIterationSpace() || !implicitIterSpace.empty())
TODO(loc, "HLFIR assignment inside FORALL or WHERE");
auto &builder = getFirOpBuilder();
@@ -2586,6 +2710,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::common::visitors{
// [1] Plain old assignment.
[&](const Fortran::evaluate::Assignment::Intrinsic &) {
+ Fortran::lower::StatementContext stmtCtx;
if (Fortran::lower::isWholeAllocatable(assign.lhs))
TODO(loc, "HLFIR assignment to whole allocatable");
hlfir::EntityWithAttributes rhs =
@@ -2601,15 +2726,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
[&](const Fortran::evaluate::ProcedureRef &procRef) {
TODO(loc, "HLFIR user defined assignment");
},
- // [3] Pointer assignment with possibly empty bounds-spec. R1035:
- // a bounds-spec is a lower bound value.
[&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
- TODO(loc, "HLFIR pointer assignment");
+ genPointerAssignment(loc, assign, lbExprs);
},
- // [4] Pointer assignment with bounds-remapping. R1036: a
- // bounds-remapping is a pair, lower bound and upper bound.
- [&](const Fortran::evaluate::Assignment::BoundsRemapping) {
- TODO(loc, "HLFIR pointer assignment with bounds remapping");
+ [&](const Fortran::evaluate::Assignment::BoundsRemapping
+ &boundExprs) {
+ genPointerAssignment(loc, assign, boundExprs);
},
},
assign.u);
@@ -2619,6 +2741,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::createArrayLoads(*this, explicitIterSpace, localSymbols);
explicitIterSpace.genLoopNest();
}
+ Fortran::lower::StatementContext stmtCtx;
std::visit(
Fortran::common::visitors{
// [1] Plain old assignment.
@@ -2734,132 +2857,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
localSymbols, ctx, /*isUserDefAssignment=*/true);
},
- // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
- // bounds-spec is a lower bound value.
[&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
- if (Fortran::evaluate::IsProcedure(assign.rhs))
- TODO(loc, "procedure pointer assignment");
-
- std::optional<Fortran::evaluate::DynamicType> lhsType =
- assign.lhs.GetType();
- // Delegate pointer association to unlimited polymorphic pointer
- // to the runtime. element size, type code, attribute and of
- // course base_addr might need to be updated.
- if (lhsType && lhsType->IsPolymorphic()) {
- if (explicitIterationSpace())
- TODO(loc, "polymorphic pointer assignment in FORALL");
- mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
- mlir::Value rhs =
- fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
- Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
- return;
- }
-
- llvm::SmallVector<mlir::Value> lbounds;
- for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
- lbounds.push_back(
- fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
- if (explicitIterationSpace()) {
- // Pointer assignment in FORALL context. Copy the rhs box value
- // into the lhs box variable.
- genArrayAssignment(assign, stmtCtx, lbounds);
- return;
- }
- fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
- Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs,
- lbounds, stmtCtx);
+ return genPointerAssignment(loc, assign, lbExprs);
},
-
- // [4] Pointer assignment with bounds-remapping. R1036: a
- // bounds-remapping is a pair, lower bound and upper bound.
[&](const Fortran::evaluate::Assignment::BoundsRemapping
&boundExprs) {
- llvm::SmallVector<mlir::Value> lbounds;
- llvm::SmallVector<mlir::Value> ubounds;
- for (const std::pair<Fortran::evaluate::ExtentExpr,
- Fortran::evaluate::ExtentExpr> &pair :
- boundExprs) {
- const Fortran::evaluate::ExtentExpr &lbExpr = pair.first;
- const Fortran::evaluate::ExtentExpr &ubExpr = pair.second;
- lbounds.push_back(
- fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
- ubounds.push_back(
- fir::getBase(genExprValue(toEvExpr(ubExpr), stmtCtx)));
- }
-
- std::optional<Fortran::evaluate::DynamicType> lhsType =
- assign.lhs.GetType();
- std::optional<Fortran::evaluate::DynamicType> rhsType =
- assign.rhs.GetType();
- // Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
- if ((lhsType && lhsType->IsPolymorphic()) ||
- (rhsType && rhsType->IsPolymorphic())) {
- if (explicitIterationSpace())
- TODO(loc, "polymorphic pointer assignment in FORALL");
-
- mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
- mlir::Value rhs =
- fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
-
- // Create the newRank x 2 array with the bounds to be passed to
- // the runtime as a descriptor.
- assert(lbounds.size() && ubounds.size());
- mlir::Type indexTy = builder->getIndexType();
- mlir::Type boundArrayTy = fir::SequenceType::get(
- {static_cast<int64_t>(lbounds.size()) * 2},
- builder->getI64Type());
- mlir::Value boundArray =
- builder->create<fir::AllocaOp>(loc, boundArrayTy);
- mlir::Value array =
- builder->create<fir::UndefOp>(loc, boundArrayTy);
- for (unsigned i = 0; i < lbounds.size(); ++i) {
- array = builder->create<fir::InsertValueOp>(
- loc, boundArrayTy, array, lbounds[i],
- builder->getArrayAttr({builder->getIntegerAttr(
- builder->getIndexType(), static_cast<int>(i * 2))}));
- array = builder->create<fir::InsertValueOp>(
- loc, boundArrayTy, array, ubounds[i],
- builder->getArrayAttr({builder->getIntegerAttr(
- builder->getIndexType(),
- static_cast<int>(i * 2 + 1))}));
- }
- builder->create<fir::StoreOp>(loc, array, boundArray);
- mlir::Type boxTy = fir::BoxType::get(boundArrayTy);
- mlir::Value ext = builder->createIntegerConstant(
- loc, indexTy, lbounds.size() * 2);
- mlir::Value shapeOp = builder->genShape(loc, {ext});
- mlir::Value boundsDesc = builder->create<fir::EmboxOp>(
- loc, boxTy, boundArray, shapeOp);
- Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs,
- rhs, boundsDesc);
- return;
- }
- if (explicitIterationSpace()) {
- // Pointer assignment in FORALL context. Copy the rhs box value
- // into the lhs box variable.
- genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
- return;
- }
- fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
- if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
- assign.rhs)) {
- fir::factory::disassociateMutableBox(*builder, loc, lhs);
- return;
- }
- // Do not generate a temp in case rhs is an array section.
- fir::ExtendedValue rhs =
- Fortran::lower::isArraySectionWithoutVectorSubscript(
- assign.rhs)
- ? Fortran::lower::createSomeArrayBox(
- *this, assign.rhs, localSymbols, stmtCtx)
- : genExprAddr(assign.rhs, stmtCtx);
- fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs,
- rhs, lbounds, ubounds);
- if (explicitIterationSpace()) {
- mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
- if (!inners.empty())
- builder->create<fir::ResultOp>(loc, inners);
- }
+ return genPointerAssignment(loc, assign, boundExprs);
},
},
assign.u);
@@ -3732,6 +3735,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void createRuntimeTypeInfoGlobals() {}
+ bool lowerToHighLevelFIR() const {
+ return bridge.getLoweringOptions().getLowerToHighLevelFIR();
+ }
+
//===--------------------------------------------------------------------===//
Fortran::lower::LoweringBridge &bridge;
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index a682697258d0f..5d1257258ce01 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -724,16 +724,10 @@ static hlfir::EntityWithAttributes genIntrinsicRefCore(
operands.emplace_back(
Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
continue;
- case Fortran::lower::LowerIntrinsicArgAs::Addr: {
- const auto *argExpr = callContext.procRef.UnwrapArgExpr(arg.index());
- bool isSimplyContiguous =
- actual.isScalar() ||
- (argExpr && Fortran::evaluate::IsSimplyContiguous(
- *argExpr, converter.getFoldingContext()));
- operands.emplace_back(Fortran::lower::convertToAddress(
- loc, converter, actual, isSimplyContiguous, stmtCtx));
+ case Fortran::lower::LowerIntrinsicArgAs::Addr:
+ operands.emplace_back(
+ Fortran::lower::convertToAddress(loc, converter, actual, stmtCtx));
continue;
- }
case Fortran::lower::LowerIntrinsicArgAs::Box:
operands.emplace_back(
Fortran::lower::convertToBox(loc, converter, actual, stmtCtx));
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index da6c9d211a9ae..062d827e59ad1 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1272,20 +1272,15 @@ fir::BoxValue Fortran::lower::convertExprToBox(
return convertToBox(loc, converter, loweredExpr, stmtCtx);
}
-fir::ExtendedValue
-Fortran::lower::convertToAddress(mlir::Location loc,
- Fortran::lower::AbstractConverter &converter,
- hlfir::Entity entity, bool isSimplyContiguous,
- Fortran::lower::StatementContext &stmtCtx) {
- if (!isSimplyContiguous)
- TODO(loc, "genExprAddr of non contiguous variables in HLFIR");
- fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
- loc, converter.getFirOpBuilder(), entity, stmtCtx);
+fir::ExtendedValue Fortran::lower::convertToAddress(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+ fir::ExtendedValue exv =
+ Fortran::lower::translateToExtendedValue(loc, builder, entity, stmtCtx);
if (fir::isa_trivial(fir::getBase(exv).getType()))
TODO(loc, "place trivial in memory");
- if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
- exv = fir::factory::genMutableBoxRead(converter.getFirOpBuilder(), loc,
- *mutableBox);
return exv;
}
fir::ExtendedValue Fortran::lower::convertExprToAddress(
@@ -1294,11 +1289,7 @@ fir::ExtendedValue Fortran::lower::convertExprToAddress(
Fortran::lower::StatementContext &stmtCtx) {
hlfir::EntityWithAttributes loweredExpr =
HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
- bool isSimplyContiguous =
- expr.Rank() == 0 || Fortran::evaluate::IsSimplyContiguous(
- expr, converter.getFoldingContext());
- return convertToAddress(loc, converter, loweredExpr, isSimplyContiguous,
- stmtCtx);
+ return convertToAddress(loc, converter, loweredExpr, stmtCtx);
}
fir::ExtendedValue Fortran::lower::convertToValue(
@@ -1335,3 +1326,20 @@ fir::ExtendedValue Fortran::lower::convertExprToValue(
HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
return convertToValue(loc, converter, loweredExpr, stmtCtx);
}
+
+fir::MutableBoxValue Fortran::lower::convertExprToMutableBox(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
+ // Pointers and Allocatable cannot be temporary expressions. Temporaries may
+ // be created while lowering it (e.g. if any indices expression of a
+ // designator create temporaries), but they can be destroyed before using the
+ // lowered pointer or allocatable;
+ Fortran::lower::StatementContext localStmtCtx;
+ hlfir::EntityWithAttributes loweredExpr =
+ HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr);
+ fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
+ loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx);
+ auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>();
+ assert(mutableBox && "expression could not be lowered to mutable box");
+ return *mutableBox;
+}
diff --git a/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90 b/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
new file mode 100644
index 0000000000000..0c353a3ea730f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
@@ -0,0 +1,111 @@
+! Test lowering of allocate, deallocate and pointer assignment statements to
+! HLFIR.
+! RUN: bbc -emit-fir -hlfir -o - %s -I nw | FileCheck %s
+
+subroutine allocation(x)
+ character(*), allocatable :: x(:)
+! CHECK-LABEL: func.func @_QPallocation(
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_2:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, {{.*}}Ex
+ deallocate(x)
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK: fir.freemem %[[VAL_5]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_6]](%[[VAL_8]]) typeparams %[[VAL_2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
+ allocate(x(100))
+! CHECK: %[[VAL_10:.*]] = arith.constant 100 : i32
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_15:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_2]] : index), %[[VAL_14]] {uniq_name = "_QFallocationEx.alloc"}
+! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) typeparams %[[VAL_2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
+! CHECK: fir.store %[[VAL_17]] to %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+end subroutine
+
+subroutine pointer_assignment(p, ziel)
+ real, pointer :: p(:)
+ real, target :: ziel(42:)
+! CHECK-LABEL: func.func @_QPpointer_assignment(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, {{.*}}Ep
+! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>, {{.*}}Eziel
+ p => ziel
+! CHECK: %[[VAL_7:.*]] = fir.shift %[[VAL_4:.*]] : (index) -> !fir.shift<1>
+! CHECK: %[[VAL_8:.*]] = fir.rebox %[[VAL_6]]#1(%[[VAL_7]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_8]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+ p => ziel(42:77:3)
+! CHECK: %[[VAL_14:.*]] = hlfir.designate %{{.*}}#0 (%{{.*}}:%{{.*}}:%{{.*}}) shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<12xf32>>
+! CHECK: %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box<!fir.array<12xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_15]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+end subroutine
+
+subroutine pointer_remapping(p, ziel)
+ real, pointer :: p(:, :)
+ real, target :: ziel(10, 20, 30)
+! CHECK-LABEL: func.func @_QPpointer_remapping(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, {{.*}}Ep
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>, {{.*}}Eziel
+ p(2:7, 3:102) => ziel
+! CHECK: %[[VAL_8:.*]] = arith.constant 2 : i64
+! CHECK: %[[VAL_9:.*]] = arith.constant 7 : i64
+! CHECK: %[[VAL_10:.*]] = arith.constant 3 : i64
+! CHECK: %[[VAL_11:.*]] = arith.constant 102 : i64
+! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+! CHECK: %[[VAL_15:.*]] = arith.subi %[[VAL_14]], %[[VAL_13]] : index
+! CHECK: %[[VAL_16:.*]] = arith.addi %[[VAL_15]], %[[VAL_12]] : index
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index
+! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_12]] : index
+! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]]#1 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
+! CHECK: %[[VAL_22:.*]] = fir.shape_shift %[[VAL_8]], %[[VAL_16]], %[[VAL_10]], %[[VAL_20]] : (i64, index, i64, index) -> !fir.shapeshift<2>
+! CHECK: %[[VAL_23:.*]] = fir.embox %[[VAL_21]](%[[VAL_22]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK: fir.store %[[VAL_23]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+end subroutine
+
+subroutine alloc_comp(x)
+ type t
+ real, allocatable :: a(:)
+ end type
+ type(t) :: x(10)
+! CHECK-LABEL: func.func @_QPalloc_comp(
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {{.*}}Ex
+ allocate(x(10_8)%a(100_8))
+! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_4]]) : (!fir.ref<!fir.array<10x!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
+! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_5]]{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant 100 : i64
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
+! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
+! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {uniq_name = "_QEa.alloc"}
+! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_14]] to %[[VAL_6]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+end subroutine
+
+subroutine ptr_comp_assign(x, ziel)
+ type t
+ real, pointer :: p(:)
+ end type
+ type(t) :: x(10)
+! CHECK-LABEL: func.func @_QPptr_comp_assign(
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex
+ real, target :: ziel(100)
+ x(9_8)%p => ziel
+! CHECK: %[[VAL_5:.*]] = arith.constant 100 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>, {{.*}}Eziel
+! CHECK: %[[VAL_8:.*]] = arith.constant 9 : index
+! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_8]]) : (!fir.ref<!fir.array<10x!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_7]]#1(%[[VAL_11]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_12]] to %[[VAL_10]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+end subroutine
More information about the flang-commits
mailing list