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

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
113 changes: 59 additions & 54 deletions flang/lib/Lower/Bridge.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -4813,40 +4813,22 @@ class FirConverter : public Fortran::lower::AbstractConverter {

// Generate pointer assignment with possibly empty bounds-spec. R1035: a
// bounds-spec is a lower bound value.
void genPointerAssignment(
void genNoHLFIRPointerAssignment(
mlir::Location loc, const Fortran::evaluate::Assignment &assign,
const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
Fortran::lower::StatementContext stmtCtx;

if (!lowerToHighLevelFIR() &&
Fortran::evaluate::IsProcedureDesignator(assign.rhs))
assert(!lowerToHighLevelFIR() && "code should not be called with HFLIR");
if (Fortran::evaluate::IsProcedureDesignator(assign.rhs))
TODO(loc, "procedure pointer assignment");
if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
loc, *this, assign.lhs, localSymbols, stmtCtx);
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
assign.rhs)) {
// rhs is null(). rhs being null(pptr) is handled in genNull.
auto boxTy{
Fortran::lower::getUntypedBoxProcType(builder->getContext())};
hlfir::Entity rhs(
fir::factory::createNullBoxProc(*builder, loc, boxTy));
builder->createStoreWithConvert(loc, rhs, lhs);
return;
}
hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
loc, *this, assign.rhs, localSymbols, stmtCtx)));
builder->createStoreWithConvert(loc, rhs, lhs);
return;
}

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())
if (explicitIterationSpace())
TODO(loc, "polymorphic pointer assignment in FORALL");
llvm::SmallVector<mlir::Value> lbounds;
for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
Expand All @@ -4873,7 +4855,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
llvm::SmallVector<mlir::Value> lbounds;
for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
if (explicitIterationSpace()) {
// Pointer assignment in FORALL context. Copy the rhs box value
// into the lhs box variable.
genArrayAssignment(assign, stmtCtx, lbounds);
Expand All @@ -4884,6 +4866,21 @@ class FirConverter : public Fortran::lower::AbstractConverter {
stmtCtx);
}

void genPointerAssignment(mlir::Location loc,
const Fortran::evaluate::Assignment &assign) {
if (isInsideHlfirForallOrWhere()) {
// Generate Pointer assignment as hlfir.region_assign.
genForallPointerAssignment(loc, assign);
return;
}
Fortran::lower::StatementContext stmtCtx;
hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
loc, *this, assign.lhs, localSymbols, stmtCtx);
mlir::Value rhs = genPointerAssignmentRhs(loc, lhs, assign, stmtCtx);
builder->createStoreWithConvert(loc, rhs, lhs);
cuf::genPointerSync(lhs, *builder);
}

void genForallPointerAssignment(mlir::Location loc,
const Fortran::evaluate::Assignment &assign) {
// Lower pointer assignment inside forall with hlfir.region_assign with
Expand All @@ -4904,8 +4901,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Lower RHS in its own region.
builder->createBlock(&regionAssignOp.getRhsRegion());
Fortran::lower::StatementContext rhsContext;
mlir::Value rhs =
genForallPointerAssignmentRhs(loc, lhs, assign, rhsContext);
mlir::Value rhs = genPointerAssignmentRhs(loc, lhs, assign, rhsContext);
auto rhsYieldOp = hlfir::YieldOp::create(*builder, loc, rhs);
Fortran::lower::genCleanUpInRegionIfAny(
loc, *builder, rhsYieldOp.getCleanup(), rhsContext);
Expand All @@ -4921,9 +4917,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}

mlir::Value
genForallPointerAssignmentRhs(mlir::Location loc, mlir::Value lhs,
const Fortran::evaluate::Assignment &assign,
Fortran::lower::StatementContext &rhsContext) {
genPointerAssignmentRhs(mlir::Location loc, hlfir::Entity lhs,
const Fortran::evaluate::Assignment &assign,
Fortran::lower::StatementContext &rhsContext) {
if (Fortran::evaluate::IsProcedureDesignator(assign.lhs)) {
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
assign.rhs))
Expand All @@ -4935,11 +4931,34 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Data target.
auto lhsBoxType =
llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(lhs.getType()));
// For NULL, create disassociated descriptor whose dynamic type is
// the static type of the LHS.
// For NULL, create disassociated descriptor whose dynamic type is the
// static type of the LHS (fulfills 7.3.2.3 requirements that the dynamic
// type of a deallocated polymorphic pointer is its static type).
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
assign.rhs))
return fir::factory::createUnallocatedBox(*builder, loc, lhsBoxType, {});
assign.rhs)) {
llvm::SmallVector<mlir::Value, 1> nonDeferredLenParams;
if (auto lhsVar =
llvm::dyn_cast_if_present<fir::FortranVariableOpInterface>(
lhs.getDefiningOp()))
nonDeferredLenParams = lhsVar.getExplicitTypeParams();
if (isInsideHlfirForallOrWhere()) {
// Inside FORALL, the non deferred type parameters may only be
// accessible in the hlfir.region_assign lhs region if they were
// computed there.
for (mlir::Value &param : nonDeferredLenParams)
if (!param.getParentRegion()->isAncestor(
builder->getBlock()->getParent())) {
if (llvm::isa_and_nonnull<mlir::arith::ConstantOp>(
param.getDefiningOp()))
param = builder->clone(*param.getDefiningOp())->getResult(0);
else
TODO(loc, "Pointer assignment with non deferred type parameter "
"inside FORALL");
}
}
return fir::factory::createUnallocatedBox(*builder, loc, lhsBoxType,
nonDeferredLenParams);
}
hlfir::Entity rhs = Fortran::lower::convertExprToHLFIR(
loc, *this, assign.rhs, localSymbols, rhsContext);
auto rhsBoxType = rhs.getBoxType();
Expand Down Expand Up @@ -5032,9 +5051,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {

// Pointer assignment with bounds-remapping. R1036: a bounds-remapping is a
// pair, lower bound and upper bound.
void genPointerAssignment(
void genNoHLFIRPointerAssignment(
mlir::Location loc, const Fortran::evaluate::Assignment &assign,
const Fortran::evaluate::Assignment::BoundsRemapping &boundExprs) {
assert(!lowerToHighLevelFIR() && "code should not be called with HFLIR");
Fortran::lower::StatementContext stmtCtx;
llvm::SmallVector<mlir::Value> lbounds;
llvm::SmallVector<mlir::Value> ubounds;
Expand All @@ -5053,7 +5073,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
if ((lhsType && lhsType->IsPolymorphic()) ||
(rhsType && rhsType->IsPolymorphic())) {
if (!lowerToHighLevelFIR() && explicitIterationSpace())
if (explicitIterationSpace())
TODO(loc, "polymorphic pointer assignment in FORALL");

fir::MutableBoxValue lhsMutableBox = genExprMutableBox(loc, assign.lhs);
Expand All @@ -5071,7 +5091,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
rhsType->IsPolymorphic());
return;
}
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
if (explicitIterationSpace()) {
// Pointer assignment in FORALL context. Copy the rhs box value
// into the lhs box variable.
genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
Expand All @@ -5083,13 +5103,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::factory::disassociateMutableBox(*builder, loc, lhs);
return;
}
if (lowerToHighLevelFIR()) {
fir::ExtendedValue rhs = genExprAddr(assign.rhs, stmtCtx);
fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs, rhs,
lbounds, ubounds);
return;
}
// Legacy lowering below.
// Do not generate a temp in case rhs is an array section.
fir::ExtendedValue rhs =
Fortran::lower::isArraySectionWithoutVectorSubscript(assign.rhs)
Expand Down Expand Up @@ -5479,18 +5492,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
dirs);
},
[&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
if (isInsideHlfirForallOrWhere())
genForallPointerAssignment(loc, assign);
else
genPointerAssignment(loc, assign, lbExprs);
genPointerAssignment(loc, assign);
},
[&](const Fortran::evaluate::Assignment::BoundsRemapping
&boundExprs) {
if (isInsideHlfirForallOrWhere())
genForallPointerAssignment(loc, assign);
else
genPointerAssignment(loc, assign, boundExprs);
},
&boundExprs) { genPointerAssignment(loc, assign); },
},
assign.u);
return;
Expand Down Expand Up @@ -5692,11 +5697,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
},

[&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
return genPointerAssignment(loc, assign, lbExprs);
return genNoHLFIRPointerAssignment(loc, assign, lbExprs);
},
[&](const Fortran::evaluate::Assignment::BoundsRemapping
&boundExprs) {
return genPointerAssignment(loc, assign, boundExprs);
return genNoHLFIRPointerAssignment(loc, assign, boundExprs);
},
},
assign.u);
Expand Down
6 changes: 3 additions & 3 deletions flang/lib/Optimizer/Builder/HLFIRTools.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -402,9 +402,9 @@ hlfir::Entity hlfir::genVariableBox(mlir::Location loc,
fir::BoxType::get(var.getElementOrSequenceType(), isVolatile);
if (forceBoxType) {
boxType = forceBoxType;
mlir::Type baseType =
fir::ReferenceType::get(fir::unwrapRefType(forceBoxType.getEleTy()));
addr = builder.createConvert(loc, baseType, addr);
mlir::Type baseType = fir::ReferenceType::get(
fir::unwrapRefType(forceBoxType.getEleTy()), forceBoxType.isVolatile());
addr = builder.createConvertWithVolatileCast(loc, baseType, addr);
}
auto embox = fir::EmboxOp::create(builder, loc, boxType, addr, shape,
/*slice=*/mlir::Value{}, typeParams);
Expand Down
50 changes: 26 additions & 24 deletions flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ subroutine pointer_assignment(p, ziel)
! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) dummy_scope %{{[0-9]+}} arg {{[0-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: %[[VAL_8:.*]] = fir.rebox %[[VAL_6]]#0(%[[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]]#0 : !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>>
Expand All @@ -49,27 +49,29 @@ subroutine pointer_remapping(p, ziel)
! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, {{.*}}Ep
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) dummy_scope %{{[0-9]+}} arg {{[0-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: %[[cmp0:.*]] = arith.cmpi sgt, %[[VAL_16]], %c0{{.*}} : index
! CHECK: %[[ext0:.*]] = arith.select %[[cmp0]], %[[VAL_16]], %c0{{.*}} : 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: %[[cmp1:.*]] = arith.cmpi sgt, %[[VAL_20]], %c0{{.*}} : index
! CHECK: %[[ext1:.*]] = arith.select %[[cmp1]], %[[VAL_20]], %c0{{.*}} : index
! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
! CHECK: %[[VAL_22:.*]] = fir.shape_shift %[[VAL_8]], %[[ext0]], %[[VAL_10]], %[[ext1]] : (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]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?x?xf32>>
! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[CONVERT_0]](%[[VAL_6]]) : (!fir.ref<!fir.array<?x?x?xf32>>, !fir.shape<3>) -> !fir.box<!fir.ptr<!fir.array<?x?x?xf32>>>
! CHECK: %[[CONSTANT_3:.*]] = arith.constant 0 : index
! CHECK: %[[CONSTANT_4:.*]] = arith.constant 1 : index
! CHECK: %[[CONSTANT_5:.*]] = arith.constant 2 : i64
! CHECK: %[[CONVERT_1:.*]] = fir.convert %[[CONSTANT_5]] : (i64) -> index
! CHECK: %[[CONSTANT_6:.*]] = arith.constant 7 : i64
! CHECK: %[[CONVERT_2:.*]] = fir.convert %[[CONSTANT_6]] : (i64) -> index
! CHECK: %[[SUBI_0:.*]] = arith.subi %[[CONVERT_2]], %[[CONVERT_1]] : index
! CHECK: %[[ADDI_0:.*]] = arith.addi %[[SUBI_0]], %[[CONSTANT_4]] : index
! CHECK: %[[CMPI_0:.*]] = arith.cmpi sgt, %[[ADDI_0]], %[[CONSTANT_3]] : index
! CHECK: %[[SELECT_0:.*]] = arith.select %[[CMPI_0]], %[[ADDI_0]], %[[CONSTANT_3]] : index
! CHECK: %[[CONSTANT_7:.*]] = arith.constant 3 : i64
! CHECK: %[[CONVERT_3:.*]] = fir.convert %[[CONSTANT_7]] : (i64) -> index
! CHECK: %[[CONSTANT_8:.*]] = arith.constant 102 : i64
! CHECK: %[[CONVERT_4:.*]] = fir.convert %[[CONSTANT_8]] : (i64) -> index
! CHECK: %[[SUBI_1:.*]] = arith.subi %[[CONVERT_4]], %[[CONVERT_3]] : index
! CHECK: %[[ADDI_1:.*]] = arith.addi %[[SUBI_1]], %[[CONSTANT_4]] : index
! CHECK: %[[CMPI_1:.*]] = arith.cmpi sgt, %[[ADDI_1]], %[[CONSTANT_3]] : index
! CHECK: %[[SELECT_1:.*]] = arith.select %[[CMPI_1]], %[[ADDI_1]], %[[CONSTANT_3]] : index
! CHECK: %[[SHAPE_SHIFT_0:.*]] = fir.shape_shift %[[CONVERT_1]], %[[SELECT_0]], %[[CONVERT_3]], %[[SELECT_1]] : (index, index, index, index) -> !fir.shapeshift<2>
! CHECK: %[[REBOX_0:.*]] = fir.rebox %[[EMBOX_0]](%[[SHAPE_SHIFT_0]]) : (!fir.box<!fir.ptr<!fir.array<?x?x?xf32>>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
! CHECK: fir.store %[[REBOX_0]] to %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
end subroutine

subroutine alloc_comp(x)
Expand Down Expand Up @@ -109,7 +111,7 @@ subroutine ptr_comp_assign(x, ziel)
! 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]]#0(%[[VAL_11]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK: %[[CAST:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>>
! CHECK: %[[VAL_12:.*]] = fir.embox %[[CAST]](%[[VAL_6]]) : (!fir.ref<!fir.array<?xf32>>, !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
Loading