Skip to content

Commit 31c0214

Browse files
schweitzpgischweitzpgi
authored
Merge pull request #1009 from schweitzpgi/ch-forall6
Implement pointer assignment in FORALL context.
2 parents 1411c56 + 87e5c48 commit 31c0214

File tree

13 files changed

+492
-195
lines changed

13 files changed

+492
-195
lines changed

‎flang/include/flang/Lower/ConvertExpr.h

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -134,12 +134,29 @@ void createAnyMaskedArrayAssignment(
134134
ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
135135
SymMap &symMap, StatementContext &stmtCtx);
136136

137+
/// In the context of a FORALL, a pointer assignment is allowed. The pointer
138+
/// assignment can be elementwise on an array of pointers. The bounds
139+
/// expressions as well as the component path may contain references to the
140+
/// concurrent control variables. The explicit iteration space must be defined.
141+
void createAnyArrayPointerAssignment(
142+
AbstractConverter &converter, const evaluate::Expr<evaluate::SomeType> &lhs,
143+
const evaluate::Expr<evaluate::SomeType> &rhs,
144+
const evaluate::Assignment::BoundsSpec &bounds,
145+
ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
146+
SymMap &symMap);
147+
/// Support the bounds remapping flavor of pointer assignment.
148+
void createAnyArrayPointerAssignment(
149+
AbstractConverter &converter, const evaluate::Expr<evaluate::SomeType> &lhs,
150+
const evaluate::Expr<evaluate::SomeType> &rhs,
151+
const evaluate::Assignment::BoundsRemapping &bounds,
152+
ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
153+
SymMap &symMap);
154+
137155
/// Lower an assignment to an allocatable array, allocating the array if
138156
/// it is not allocated yet or reallocation it if it does not conform
139157
/// with the right hand side.
140158
void createAllocatableArrayAssignment(
141-
AbstractConverter &converter,
142-
const evaluate::Expr<evaluate::SomeType> &lhs,
159+
AbstractConverter &converter, const evaluate::Expr<evaluate::SomeType> &lhs,
143160
const evaluate::Expr<evaluate::SomeType> &rhs,
144161
ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
145162
SymMap &symMap, StatementContext &stmtCtx);

‎flang/include/flang/Lower/Support/Utils.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
#include "flang/Common/indirection.h"
1717
#include "flang/Optimizer/Support/Utils.h"
1818
#include "flang/Parser/char-block.h"
19+
#include "flang/Semantics/tools.h"
1920
#include "llvm/ADT/StringRef.h"
2021

2122
//===----------------------------------------------------------------------===//
@@ -37,4 +38,11 @@ const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
3738
return a.value();
3839
}
3940

41+
/// Clone subexpression and wrap it as a generic `Fortran::evaluate::Expr`.
42+
template <typename A>
43+
static Fortran::evaluate::Expr<Fortran::evaluate::SomeType>
44+
toEvExpr(const A &x) {
45+
return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x));
46+
}
47+
4048
#endif // FORTRAN_LOWER_SUPPORT_UTILS_H

‎flang/include/flang/Optimizer/Builder/BoxValue.h

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -410,8 +410,6 @@ class ExtendedValue : public details::matcher<ExtendedValue> {
410410
ProcBoxValue, BoxValue, MutableBoxValue>;
411411

412412
ExtendedValue() : box{UnboxedValue{}} {}
413-
ExtendedValue(const ExtendedValue &) = default;
414-
ExtendedValue(ExtendedValue &&) = default;
415413
template <typename A, typename = std::enable_if_t<
416414
!std::is_same_v<std::decay_t<A>, ExtendedValue>>>
417415
constexpr ExtendedValue(A &&a) : box{std::forward<A>(a)} {

‎flang/include/flang/Optimizer/Builder/FIRBuilder.h

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -420,7 +420,6 @@ mlir::Value locationToLineNo(fir::FirOpBuilder &, mlir::Location, mlir::Type);
420420
/// the component.
421421
fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder,
422422
mlir::Location loc,
423-
const fir::ExtendedValue &obj,
424423
mlir::Value component);
425424

426425
} // namespace fir::factory

‎flang/include/flang/Optimizer/Builder/MutableBox.h

Lines changed: 25 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -45,24 +45,25 @@ mlir::Value createUnallocatedBox(fir::FirOpBuilder &builder, mlir::Location loc,
4545
/// The created MutableBoxValue wraps a fir.ref<fir.box<fir.heap<type>>> and is
4646
/// initialized to unallocated/diassociated status. An optional name can be
4747
/// given to the created !fir.ref<fir.box>.
48-
fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &, mlir::Location,
49-
mlir::Type type,
48+
fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder,
49+
mlir::Location loc, mlir::Type type,
5050
llvm::StringRef name = {});
5151

5252
/// Update a MutableBoxValue to describe entity \p source (that must be in
5353
/// memory). If \lbounds is not empty, it is used to defined the MutableBoxValue
5454
/// lower bounds, otherwise, the lower bounds from \p source are used.
55-
void associateMutableBox(fir::FirOpBuilder &, mlir::Location,
56-
const fir::MutableBoxValue &,
55+
void associateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
56+
const fir::MutableBoxValue &box,
5757
const fir::ExtendedValue &source,
5858
mlir::ValueRange lbounds);
5959

6060
/// Update a MutableBoxValue to describe entity \p source (that must be in
6161
/// memory) with a new array layout given by \p lbounds and \p ubounds.
6262
/// \p source must be known to be contiguous at compile time, or it must have
6363
/// rank 1 (constraint from Fortran 2018 standard 10.2.2.3 point 9).
64-
void associateMutableBoxWithRemap(fir::FirOpBuilder &, mlir::Location,
65-
const fir::MutableBoxValue &,
64+
void associateMutableBoxWithRemap(fir::FirOpBuilder &builder,
65+
mlir::Location loc,
66+
const fir::MutableBoxValue &box,
6667
const fir::ExtendedValue &source,
6768
mlir::ValueRange lbounds,
6869
mlir::ValueRange ubounds);
@@ -71,8 +72,8 @@ void associateMutableBoxWithRemap(fir::FirOpBuilder &, mlir::Location,
7172
/// disassociated/unallocated. Nothing is done with the entity that was
7273
/// previously associated/allocated. The function generates code that sets the
7374
/// address field of the MutableBoxValue to zero.
74-
void disassociateMutableBox(fir::FirOpBuilder &, mlir::Location,
75-
const fir::MutableBoxValue &);
75+
void disassociateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
76+
const fir::MutableBoxValue &box);
7677

7778
/// Generate code to conditionally reallocate a MutableBoxValue with a new
7879
/// shape, lower bounds, and length parameters if it is unallocated or if its
@@ -85,14 +86,15 @@ void disassociateMutableBox(fir::FirOpBuilder &, mlir::Location,
8586
/// parameter mismatch can trigger a reallocation. See Fortran 10.2.1.3 point 3
8687
/// that this function is implementing for more details. The polymorphic
8788
/// requirements are not yet covered by this function.
88-
void genReallocIfNeeded(fir::FirOpBuilder &, mlir::Location,
89-
const fir::MutableBoxValue &, mlir::ValueRange lbounds,
90-
mlir::ValueRange shape, mlir::ValueRange lengthParams);
89+
void genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc,
90+
const fir::MutableBoxValue &box,
91+
mlir::ValueRange lbounds, mlir::ValueRange shape,
92+
mlir::ValueRange lengthParams);
9193

9294
/// Finalize a mutable box if it is allocated or associated. This includes both
9395
/// calling the finalizer, if any, and deallocating the storage.
94-
void genFinalization(fir::FirOpBuilder &, mlir::Location,
95-
const fir::MutableBoxValue &);
96+
void genFinalization(fir::FirOpBuilder &builder, mlir::Location loc,
97+
const fir::MutableBoxValue &box);
9698

9799
void genInlinedAllocation(fir::FirOpBuilder &builder, mlir::Location loc,
98100
const fir::MutableBoxValue &box,
@@ -106,28 +108,30 @@ void genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
106108
/// When the MutableBoxValue was passed as a fir.ref<fir.box> to a call that may
107109
/// have modified it, update the MutableBoxValue according to the
108110
/// fir.ref<fir.box> value.
109-
void syncMutableBoxFromIRBox(fir::FirOpBuilder &, mlir::Location,
110-
const fir::MutableBoxValue &);
111+
void syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, mlir::Location loc,
112+
const fir::MutableBoxValue &box);
111113

112114
/// Read all mutable properties into a normal symbol box.
113115
/// It is OK to call this on unassociated/unallocated boxes but any use of the
114116
/// resulting values will be undefined (only the base address will be guaranteed
115117
/// to be null).
116-
fir::ExtendedValue genMutableBoxRead(fir::FirOpBuilder &, mlir::Location,
117-
const fir::MutableBoxValue &,
118+
fir::ExtendedValue genMutableBoxRead(fir::FirOpBuilder &builder,
119+
mlir::Location loc,
120+
const fir::MutableBoxValue &box,
118121
bool mayBePolymorphic = true);
119122

120123
/// Returns the fir.ref<fir.box<T>> of a MutableBoxValue filled with the current
121124
/// association / allocation properties. If the fir.ref<fir.box> already exists
122125
/// and is-up to date, this is a no-op, otherwise, code will be generated to
123126
/// fill the it.
124-
mlir::Value getMutableIRBox(fir::FirOpBuilder &, mlir::Location,
125-
const fir::MutableBoxValue &);
127+
mlir::Value getMutableIRBox(fir::FirOpBuilder &builder, mlir::Location loc,
128+
const fir::MutableBoxValue &box);
126129

127130
/// Generate allocation or association status test and returns the resulting
128131
/// i1. This is testing this for a valid/non-null base address value.
129-
mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &, mlir::Location,
130-
const fir::MutableBoxValue &);
132+
mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
133+
mlir::Location loc,
134+
const fir::MutableBoxValue &box);
131135

132136
} // namespace fir::factory
133137

‎flang/include/flang/Optimizer/Dialect/FIRType.h

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,9 @@ bool isa_ref_type(mlir::Type t);
6666
bool isa_passbyref_type(mlir::Type t);
6767

6868
/// Is `t` a boxed type?
69-
bool isa_box_type(mlir::Type t);
69+
inline bool isa_box_type(mlir::Type t) {
70+
return t.isa<BoxType>() || t.isa<BoxCharType>() || t.isa<BoxProcType>();
71+
}
7072

7173
/// Is `t` a type that can conform to be pass-by-reference? Depending on the
7274
/// context, these types may simply demote to pass-by-reference or a reference
@@ -75,8 +77,14 @@ inline bool conformsWithPassByRef(mlir::Type t) {
7577
return isa_ref_type(t) || isa_box_type(t);
7678
}
7779

80+
/// Is `t` a derived (record) type?
81+
inline bool isa_derived(mlir::Type t) { return t.isa<fir::RecordType>(); }
82+
7883
/// Is `t` a FIR dialect aggregate type?
79-
bool isa_aggregate(mlir::Type t);
84+
inline bool isa_aggregate(mlir::Type t) {
85+
return t.isa<SequenceType>() || fir::isa_derived(t) ||
86+
t.isa<mlir::TupleType>();
87+
}
8088

8189
/// Extract the `Type` pointed to from a FIR memory reference type. If `t` is
8290
/// not a memory reference type, then returns a null `Type`.
@@ -127,9 +135,6 @@ inline bool isa_char_string(mlir::Type t) {
127135
return false;
128136
}
129137

130-
/// Is `t` a derived (record) type?
131-
inline bool isa_derived(mlir::Type t) { return t.isa<fir::RecordType>(); }
132-
133138
/// Is `t` a box type for which it is not possible to deduce the box size?
134139
/// It is not possible to deduce the size of a box that describes an entity
135140
/// of unknown rank or type.

‎flang/lib/Lower/Bridge.cpp

Lines changed: 23 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,6 @@
4141
#include "flang/Optimizer/Support/InternalNames.h"
4242
#include "flang/Optimizer/Transforms/Passes.h"
4343
#include "flang/Parser/parse-tree.h"
44-
#include "flang/Semantics/tools.h"
4544
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
4645
#include "mlir/Dialect/StandardOps/IR/Ops.h"
4746
#include "mlir/IR/PatternMatch.h"
@@ -101,13 +100,6 @@ struct IncrementLoopInfo {
101100
using IncrementLoopNestInfo = llvm::SmallVector<IncrementLoopInfo>;
102101
} // namespace
103102

104-
/// Clone subexpression and wrap it as a generic `Fortran::evaluate::Expr`.
105-
template <typename A>
106-
static Fortran::evaluate::Expr<Fortran::evaluate::SomeType>
107-
toEvExpr(const A &x) {
108-
return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x));
109-
}
110-
111103
//===----------------------------------------------------------------------===//
112104
// FirConverter
113105
//===----------------------------------------------------------------------===//
@@ -1754,11 +1746,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
17541746
auto fromCoor = builder->create<fir::CoordinateOp>(
17551747
loc, fldRefTy, fir::getBase(rhs), field);
17561748
auto from =
1757-
fir::factory::componentToExtendedValue(*builder, loc, rhs, fromCoor);
1749+
fir::factory::componentToExtendedValue(*builder, loc, fromCoor);
17581750
auto toCoor = builder->create<fir::CoordinateOp>(
17591751
loc, fldRefTy, fir::getBase(lhs), field);
1760-
auto to =
1761-
fir::factory::componentToExtendedValue(*builder, loc, lhs, toCoor);
1752+
auto to = fir::factory::componentToExtendedValue(*builder, loc, toCoor);
17621753
to.match(
17631754
[&](const fir::UnboxedValue &toPtr) {
17641755
// FIXME: this is incorrect after F95 to simply load/store derived
@@ -1925,8 +1916,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
19251916
if ((lhsType && lhsType->IsPolymorphic()) ||
19261917
(rhsType && rhsType->IsPolymorphic()))
19271918
TODO(loc, "pointer assignment involving polymorphic entity");
1928-
if (explicitIterationSpace())
1929-
TODO(loc, "pointer assignment within FORALL");
1919+
1920+
if (explicitIterationSpace()) {
1921+
Fortran::lower::createAnyArrayPointerAssignment(
1922+
*this, assign.lhs, assign.rhs, lbExprs, explicitIterSpace,
1923+
implicitIterSpace, localSymbols);
1924+
return;
1925+
}
19301926

19311927
auto lhs = genExprMutableBox(loc, assign.lhs);
19321928
llvm::SmallVector<mlir::Value> lbounds;
@@ -1941,20 +1937,26 @@ class FirConverter : public Fortran::lower::AbstractConverter {
19411937
// bounds-remapping is a pair, lower bound and upper bound.
19421938
[&](const Fortran::evaluate::Assignment::BoundsRemapping
19431939
&boundExprs) {
1944-
if (explicitIterationSpace())
1945-
TODO(loc, "pointer assignment within FORALL");
1946-
auto lhs = genExprMutableBox(loc, assign.lhs);
1947-
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
1948-
assign.rhs)) {
1949-
fir::factory::disassociateMutableBox(*builder, loc, lhs);
1950-
return;
1951-
}
19521940
auto lhsType = assign.lhs.GetType();
19531941
auto rhsType = assign.rhs.GetType();
19541942
// Polymorphic lhs/rhs may need more care. See F2018 10.2.2.3.
19551943
if ((lhsType && lhsType->IsPolymorphic()) ||
19561944
(rhsType && rhsType->IsPolymorphic()))
19571945
TODO(loc, "pointer assignment involving polymorphic entity");
1946+
1947+
if (explicitIterationSpace()) {
1948+
Fortran::lower::createAnyArrayPointerAssignment(
1949+
*this, assign.lhs, assign.rhs, boundExprs,
1950+
explicitIterSpace, implicitIterSpace, localSymbols);
1951+
return;
1952+
}
1953+
1954+
auto lhs = genExprMutableBox(loc, assign.lhs);
1955+
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
1956+
assign.rhs)) {
1957+
fir::factory::disassociateMutableBox(*builder, loc, lhs);
1958+
return;
1959+
}
19581960
llvm::SmallVector<mlir::Value> lbounds;
19591961
llvm::SmallVector<mlir::Value> ubounds;
19601962
for (const auto &[lbExpr, ubExpr] : boundExprs) {

0 commit comments

Comments
 (0)